Artifact e5de1331ec89d337b3d5427d4d8a31c3af4ed423:
- File srfi/tests/s26-cut.sps — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 2776)
0000: 23 21 72 36 72 73 0a 3b 20 43 4f 4e 46 49 44 45 #!r6rs.; CONFIDE 0010: 4e 43 45 20 54 45 53 54 20 46 4f 52 20 49 4d 50 NCE TEST FOR IMP 0020: 4c 45 4d 45 4e 54 41 54 49 4f 4e 20 4f 46 20 53 LEMENTATION OF S 0030: 52 46 49 2d 32 36 0a 3b 20 3d 3d 3d 3d 3d 3d 3d RFI-26.; ======= 0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0060: 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 53 65 62 61 73 ======.;.; Sebas 0070: 74 69 61 6e 2e 45 67 6e 65 72 40 70 68 69 6c 69 tian.Egner@phili 0080: 70 73 2e 63 6f 6d 2c 20 33 2d 4a 75 6e 2d 32 30 ps.com, 3-Jun-20 0090: 30 32 2e 0a 3b 0a 3b 20 54 68 69 73 20 66 69 6c 02..;.; This fil 00a0: 65 20 63 68 65 63 6b 73 20 61 20 66 65 77 20 61 e checks a few a 00b0: 73 73 65 72 74 69 6f 6e 73 20 61 62 6f 75 74 20 ssertions about 00c0: 74 68 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 the implementati 00d0: 6f 6e 2e 0a 3b 20 49 66 20 79 6f 75 20 72 75 6e on..; If you run 00e0: 20 69 74 20 61 6e 64 20 6e 6f 20 65 72 72 6f 72 it and no error 00f0: 20 6d 65 73 73 61 67 65 20 69 73 20 69 73 73 75 message is issu 0100: 65 64 2c 20 74 68 65 20 69 6d 70 6c 65 6d 65 6e ed, the implemen 0110: 74 61 74 69 6f 6e 0a 3b 20 69 73 20 63 6f 72 72 tation.; is corr 0120: 65 63 74 20 6f 6e 20 74 68 65 20 63 61 73 65 73 ect on the cases 0130: 20 74 68 61 74 20 68 61 76 65 20 62 65 65 6e 20 that have been 0140: 74 65 73 74 65 64 2e 0a 3b 0a 3b 20 63 6f 6d 70 tested..;.; comp 0150: 6c 69 61 6e 63 65 3a 0a 3b 20 20 20 53 63 68 65 liance:.; Sche 0160: 6d 65 20 52 35 52 53 20 77 69 74 68 0a 3b 20 20 me R5RS with.; 0170: 20 20 20 53 52 46 49 2d 32 33 3a 20 65 72 72 6f SRFI-23: erro 0180: 72 0a 3b 0a 3b 20 6c 6f 61 64 69 6e 67 20 74 68 r.;.; loading th 0190: 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 53 63 68 is file into Sch 01a0: 65 6d 65 20 34 38 20 30 2e 35 37 20 61 66 74 65 eme 48 0.57 afte 01b0: 72 20 27 63 75 74 2e 73 63 6d 27 20 68 61 73 20 r 'cut.scm' has 01c0: 62 65 65 6e 20 6c 6f 61 64 65 64 3a 0a 3b 20 20 been loaded:.; 01d0: 20 2c 6f 70 65 6e 20 73 72 66 69 2d 32 33 0a 3b ,open srfi-23.; 01e0: 20 20 20 2c 6c 6f 61 64 20 63 68 65 63 6b 2e 73 ,load check.s 01f0: 63 6d 0a 0a 3b 20 28 63 68 65 63 6b 20 65 78 70 cm..; (check exp 0200: 72 29 0a 3b 20 20 20 20 65 76 61 6c 73 20 65 78 r).; evals ex 0210: 70 72 20 61 6e 64 20 69 73 73 75 65 73 20 61 6e pr and issues an 0220: 20 65 72 72 6f 72 20 69 66 20 69 74 20 69 73 20 error if it is 0230: 6e 6f 74 20 23 74 2e 0a 0a 3b 3b 20 45 78 74 65 not #t...;; Exte 0240: 6e 64 65 64 20 62 79 20 44 65 72 69 63 6b 20 45 nded by Derick E 0250: 64 64 69 6e 67 74 6f 6e 20 74 6f 20 74 65 73 74 ddington to test 0260: 20 66 72 65 65 2d 69 64 65 6e 74 69 66 69 65 72 free-identifier 0270: 3d 3f 20 6f 66 20 3c 3e 20 61 6e 64 20 3c 2e 2e =? of <> and <.. 0280: 2e 3e 2e 0a 0a 28 69 6d 70 6f 72 74 0a 20 20 28 .>...(import. ( 0290: 72 6e 72 73 29 0a 20 20 28 72 6e 72 73 20 65 76 rnrs). (rnrs ev 02a0: 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 al))..(define (c 02b0: 68 65 63 6b 20 65 78 70 72 29 0a 20 20 28 69 66 heck expr). (if 02c0: 20 28 6e 6f 74 20 28 65 71 3f 20 28 65 76 61 6c (not (eq? (eval 02d0: 20 65 78 70 72 20 28 65 6e 76 69 72 6f 6e 6d 65 expr (environme 02e0: 6e 74 20 27 28 72 6e 72 73 29 20 27 28 73 75 72 nt '(rnrs) '(sur 02f0: 66 61 67 65 20 73 32 36 20 63 75 74 29 29 29 0a fage s26 cut))). 0300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0310: 23 74 29 29 0a 20 20 20 20 20 20 28 61 73 73 65 #t)). (asse 0320: 72 74 69 6f 6e 2d 76 69 6f 6c 61 74 69 6f 6e 20 rtion-violation 0330: 27 63 68 65 63 6b 20 22 63 68 65 63 6b 20 66 61 'check "check fa 0340: 69 6c 65 64 22 20 65 78 70 72 29 29 29 0a 0a 3b iled" expr)))..; 0350: 20 28 63 68 65 63 6b 2d 61 6c 6c 29 0a 3b 20 20 (check-all).; 0360: 20 20 72 75 6e 73 20 73 65 76 65 72 61 6c 20 74 runs several t 0370: 65 73 74 73 20 6f 6e 20 63 75 74 20 61 6e 64 20 ests on cut and 0380: 72 65 70 6f 72 74 73 2e 0a 0a 28 64 65 66 69 6e reports...(defin 0390: 65 20 28 63 68 65 63 6b 2d 61 6c 6c 29 0a 20 20 e (check-all). 03a0: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 63 68 (for-each . ch 03b0: 65 63 6b 0a 20 20 20 27 28 20 3b 20 63 75 74 73 eck. '( ; cuts 03c0: 0a 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 . (equal? (( 03d0: 63 75 74 20 6c 69 73 74 29 29 20 27 28 29 29 0a cut list)) '()). 03e0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 63 (equal? ((c 03f0: 75 74 20 6c 69 73 74 20 3c 2e 2e 2e 3e 29 29 20 ut list <...>)) 0400: 27 28 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c '()). (equal 0410: 3f 20 28 28 63 75 74 20 6c 69 73 74 20 31 29 29 ? ((cut list 1)) 0420: 20 27 28 31 29 29 0a 20 20 20 20 20 28 65 71 75 '(1)). (equ 0430: 61 6c 3f 20 28 28 63 75 74 20 6c 69 73 74 20 3c al? ((cut list < 0440: 3e 29 20 31 29 20 27 28 31 29 29 0a 20 20 20 20 >) 1) '(1)). 0450: 20 28 65 71 75 61 6c 3f 20 28 28 63 75 74 20 6c (equal? ((cut l 0460: 69 73 74 20 3c 2e 2e 2e 3e 29 20 31 29 20 27 28 ist <...>) 1) '( 0470: 31 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c 3f 1)). (equal? 0480: 20 28 28 63 75 74 20 6c 69 73 74 20 31 20 32 29 ((cut list 1 2) 0490: 29 20 27 28 31 20 32 29 29 0a 20 20 20 20 20 28 ) '(1 2)). ( 04a0: 65 71 75 61 6c 3f 20 28 28 63 75 74 20 6c 69 73 equal? ((cut lis 04b0: 74 20 31 20 3c 3e 29 20 32 29 20 27 28 31 20 32 t 1 <>) 2) '(1 2 04c0: 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c 3f 20 )). (equal? 04d0: 28 28 63 75 74 20 6c 69 73 74 20 31 20 3c 2e 2e ((cut list 1 <.. 04e0: 2e 3e 29 20 32 29 20 27 28 31 20 32 29 29 0a 20 .>) 2) '(1 2)). 04f0: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 63 75 (equal? ((cu 0500: 74 20 6c 69 73 74 20 31 20 3c 2e 2e 2e 3e 29 20 t list 1 <...>) 0510: 32 20 33 20 34 29 20 27 28 31 20 32 20 33 20 34 2 3 4) '(1 2 3 4 0520: 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c 3f 20 )). (equal? 0530: 28 28 63 75 74 20 6c 69 73 74 20 31 20 3c 3e 20 ((cut list 1 <> 0540: 33 20 3c 3e 29 20 32 20 34 29 20 27 28 31 20 32 3 <>) 2 4) '(1 2 0550: 20 33 20 34 29 29 0a 20 20 20 20 20 28 65 71 75 3 4)). (equ 0560: 61 6c 3f 20 28 28 63 75 74 20 6c 69 73 74 20 31 al? ((cut list 1 0570: 20 3c 3e 20 33 20 3c 2e 2e 2e 3e 29 20 32 20 34 <> 3 <...>) 2 4 0580: 20 35 20 36 29 20 27 28 31 20 32 20 33 20 34 20 5 6) '(1 2 3 4 0590: 35 20 36 29 29 0a 20 20 20 20 20 28 65 71 75 61 5 6)). (equa 05a0: 6c 3f 20 28 6c 65 74 2a 20 28 28 78 20 27 77 72 l? (let* ((x 'wr 05b0: 6f 6e 67 29 20 28 79 20 28 63 75 74 20 6c 69 73 ong) (y (cut lis 05c0: 74 20 78 29 29 29 20 28 73 65 74 21 20 78 20 27 t x))) (set! x ' 05d0: 6f 6b 29 20 28 79 29 29 20 27 28 6f 6b 29 29 0a ok) (y)) '(ok)). 05e0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 0a 20 20 (equal? . 05f0: 20 20 20 20 28 6c 65 74 20 28 28 61 20 30 29 29 (let ((a 0)) 0600: 0a 09 28 6d 61 70 20 28 63 75 74 20 2b 20 28 62 ..(map (cut + (b 0610: 65 67 69 6e 20 28 73 65 74 21 20 61 20 28 2b 20 egin (set! a (+ 0620: 61 20 31 29 29 20 61 29 20 3c 3e 29 0a 09 20 20 a 1)) a) <>).. 0630: 20 20 20 27 28 31 20 32 29 29 0a 09 61 29 0a 20 '(1 2))..a). 0640: 20 20 20 20 20 32 29 0a 20 20 20 20 20 28 65 71 2). (eq 0650: 75 61 6c 3f 0a 20 20 20 20 20 20 28 6c 65 74 2a ual?. (let* 0660: 20 28 28 3c 3e 20 27 77 72 6f 6e 67 29 20 28 66 ((<> 'wrong) (f 0670: 20 28 63 75 74 20 6c 69 73 74 20 3c 3e 20 3c 2e (cut list <> <. 0680: 2e 2e 3e 29 29 29 0a 20 20 20 20 20 20 20 20 28 ..>))). ( 0690: 73 65 74 21 20 3c 3e 20 27 6f 6b 29 0a 20 20 20 set! <> 'ok). 06a0: 20 20 20 20 20 28 66 20 31 20 32 29 29 0a 20 20 (f 1 2)). 06b0: 20 20 20 20 27 28 6f 6b 20 31 20 32 29 29 0a 20 '(ok 1 2)). 06c0: 20 20 20 20 28 65 71 75 61 6c 3f 0a 20 20 20 20 (equal?. 06d0: 20 20 28 6c 65 74 2a 20 28 28 3c 2e 2e 2e 3e 20 (let* ((<...> 06e0: 27 77 72 6f 6e 67 29 20 28 66 20 28 63 75 74 20 'wrong) (f (cut 06f0: 6c 69 73 74 20 3c 3e 20 3c 2e 2e 2e 3e 29 29 29 list <> <...>))) 0700: 0a 20 20 20 20 20 20 20 20 28 73 65 74 21 20 3c . (set! < 0710: 2e 2e 2e 3e 20 27 6f 6b 29 0a 20 20 20 20 20 20 ...> 'ok). 0720: 20 20 28 66 20 31 29 29 0a 20 20 20 20 20 20 27 (f 1)). ' 0730: 28 31 20 6f 6b 29 29 0a 20 20 20 20 20 20 3b 20 (1 ok)). ; 0740: 63 75 74 65 73 0a 20 20 20 20 20 28 65 71 75 61 cutes. (equa 0750: 6c 3f 20 28 28 63 75 74 65 20 6c 69 73 74 29 29 l? ((cute list)) 0760: 20 27 28 29 29 0a 20 20 20 20 20 28 65 71 75 61 '()). (equa 0770: 6c 3f 20 28 28 63 75 74 65 20 6c 69 73 74 20 3c l? ((cute list < 0780: 2e 2e 2e 3e 29 29 20 27 28 29 29 0a 20 20 20 20 ...>)) '()). 0790: 20 28 65 71 75 61 6c 3f 20 28 28 63 75 74 65 20 (equal? ((cute 07a0: 6c 69 73 74 20 31 29 29 20 27 28 31 29 29 0a 20 list 1)) '(1)). 07b0: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 63 75 (equal? ((cu 07c0: 74 65 20 6c 69 73 74 20 3c 3e 29 20 31 29 20 27 te list <>) 1) ' 07d0: 28 31 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c (1)). (equal 07e0: 3f 20 28 28 63 75 74 65 20 6c 69 73 74 20 3c 2e ? ((cute list <. 07f0: 2e 2e 3e 29 20 31 29 20 27 28 31 29 29 0a 20 20 ..>) 1) '(1)). 0800: 20 20 20 28 65 71 75 61 6c 3f 20 28 28 63 75 74 (equal? ((cut 0810: 65 20 6c 69 73 74 20 31 20 32 29 29 20 27 28 31 e list 1 2)) '(1 0820: 20 32 29 29 0a 20 20 20 20 20 28 65 71 75 61 6c 2)). (equal 0830: 3f 20 28 28 63 75 74 65 20 6c 69 73 74 20 31 20 ? ((cute list 1 0840: 3c 3e 29 20 32 29 20 27 28 31 20 32 29 29 0a 20 <>) 2) '(1 2)). 0850: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 63 75 (equal? ((cu 0860: 74 65 20 6c 69 73 74 20 31 20 3c 2e 2e 2e 3e 29 te list 1 <...>) 0870: 20 32 29 20 27 28 31 20 32 29 29 0a 20 20 20 20 2) '(1 2)). 0880: 20 28 65 71 75 61 6c 3f 20 28 28 63 75 74 65 20 (equal? ((cute 0890: 6c 69 73 74 20 31 20 3c 2e 2e 2e 3e 29 20 32 20 list 1 <...>) 2 08a0: 33 20 34 29 20 27 28 31 20 32 20 33 20 34 29 29 3 4) '(1 2 3 4)) 08b0: 0a 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 28 . (equal? (( 08c0: 63 75 74 65 20 6c 69 73 74 20 31 20 3c 3e 20 33 cute list 1 <> 3 08d0: 20 3c 3e 29 20 32 20 34 29 20 27 28 31 20 32 20 <>) 2 4) '(1 2 08e0: 33 20 34 29 29 0a 20 20 20 20 20 28 65 71 75 61 3 4)). (equa 08f0: 6c 3f 20 28 28 63 75 74 65 20 6c 69 73 74 20 31 l? ((cute list 1 0900: 20 3c 3e 20 33 20 3c 2e 2e 2e 3e 29 20 32 20 34 <> 3 <...>) 2 4 0910: 20 35 20 36 29 20 27 28 31 20 32 20 33 20 34 20 5 6) '(1 2 3 4 0920: 35 20 36 29 29 0a 20 20 20 20 20 28 65 71 75 61 5 6)). (equa 0930: 6c 3f 20 0a 20 20 20 20 20 20 28 6c 65 74 20 28 l? . (let ( 0940: 28 61 20 30 29 29 0a 09 28 6d 61 70 20 28 63 75 (a 0))..(map (cu 0950: 74 65 20 2b 20 28 62 65 67 69 6e 20 28 73 65 74 te + (begin (set 0960: 21 20 61 20 28 2b 20 61 20 31 29 29 20 61 29 20 ! a (+ a 1)) a) 0970: 3c 3e 29 0a 09 20 20 20 20 20 27 28 31 20 32 29 <>).. '(1 2) 0980: 29 0a 09 61 29 0a 20 20 20 20 20 20 31 29 0a 20 )..a). 1). 0990: 20 20 20 20 28 65 71 75 61 6c 3f 0a 20 20 20 20 (equal?. 09a0: 20 20 28 6c 65 74 2a 20 28 28 3c 3e 20 27 6f 6b (let* ((<> 'ok 09b0: 29 20 28 66 20 28 63 75 74 65 20 6c 69 73 74 20 ) (f (cute list 09c0: 3c 3e 20 3c 2e 2e 2e 3e 29 29 29 0a 20 20 20 20 <> <...>))). 09d0: 20 20 20 20 28 73 65 74 21 20 3c 3e 20 27 77 72 (set! <> 'wr 09e0: 6f 6e 67 29 0a 20 20 20 20 20 20 20 20 28 66 20 ong). (f 09f0: 31 20 32 29 29 0a 20 20 20 20 20 20 27 28 6f 6b 1 2)). '(ok 0a00: 20 31 20 32 29 29 0a 20 20 20 20 20 28 65 71 75 1 2)). (equ 0a10: 61 6c 3f 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 al?. (let* 0a20: 28 28 3c 2e 2e 2e 3e 20 27 6f 6b 29 20 28 66 20 ((<...> 'ok) (f 0a30: 28 63 75 74 65 20 6c 69 73 74 20 3c 3e 20 3c 2e (cute list <> <. 0a40: 2e 2e 3e 29 29 29 0a 20 20 20 20 20 20 20 20 28 ..>))). ( 0a50: 73 65 74 21 20 3c 2e 2e 2e 3e 20 27 77 72 6f 6e set! <...> 'wron 0a60: 67 29 0a 20 20 20 20 20 20 20 20 28 66 20 31 29 g). (f 1) 0a70: 29 0a 20 20 20 20 20 20 27 28 31 20 6f 6b 29 29 ). '(1 ok)) 0a80: 0a 20 20 20 20 20 29 29 29 0a 0a 3b 20 72 75 6e . )))..; run 0a90: 20 74 68 65 20 63 68 65 63 6b 73 20 77 68 65 6e the checks when 0aa0: 20 6c 6f 61 64 69 6e 67 0a 28 63 68 65 63 6b 2d loading.(check- 0ab0: 61 6c 6c 29 0a 3b 3b 20 28 64 69 73 70 6c 61 79 all).;; (display 0ac0: 20 22 70 61 73 73 65 64 22 29 0a 3b 3b 20 28 6e "passed").;; (n 0ad0: 65 77 6c 69 6e 65 29 0a ewline).