Artifact 6e491b9d32eb22a1f30f18897142972ac2e73008:
- File srfi/tests/and-let.sps — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 2595)
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 ;; Copyright (c) 0010: 20 32 30 30 39 20 44 65 72 69 63 6b 20 45 64 64 2009 Derick Edd 0020: 69 6e 67 74 6f 6e 2e 20 20 41 6c 6c 20 72 69 67 ington. All rig 0030: 68 74 73 20 72 65 73 65 72 76 65 64 2e 20 20 4c hts reserved. L 0040: 69 63 65 6e 73 65 64 20 75 6e 64 65 72 20 61 6e icensed under an 0050: 0a 3b 3b 20 4d 49 54 2d 73 74 79 6c 65 20 6c 69 .;; MIT-style li 0060: 63 65 6e 73 65 2e 20 20 4d 79 20 6c 69 63 65 6e cense. My licen 0070: 73 65 20 69 73 20 69 6e 20 74 68 65 20 66 69 6c se is in the fil 0080: 65 20 6e 61 6d 65 64 20 4c 49 43 45 4e 53 45 20 e named LICENSE 0090: 66 72 6f 6d 20 74 68 65 20 6f 72 69 67 69 6e 61 from the origina 00a0: 6c 0a 3b 3b 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 l.;; collection 00b0: 74 68 69 73 20 66 69 6c 65 20 69 73 20 64 69 73 this file is dis 00c0: 74 72 69 62 75 74 65 64 20 77 69 74 68 2e 20 20 tributed with. 00d0: 49 66 20 74 68 69 73 20 66 69 6c 65 20 69 73 20 If this file is 00e0: 72 65 64 69 73 74 72 69 62 75 74 65 64 20 77 69 redistributed wi 00f0: 74 68 0a 3b 3b 20 73 6f 6d 65 20 6f 74 68 65 72 th.;; some other 0100: 20 63 6f 6c 6c 65 63 74 69 6f 6e 2c 20 6d 79 20 collection, my 0110: 6c 69 63 65 6e 73 65 20 6d 75 73 74 20 61 6c 73 license must als 0120: 6f 20 62 65 20 69 6e 63 6c 75 64 65 64 2e 0a 0a o be included... 0130: 23 21 72 36 72 73 0a 28 69 6d 70 6f 72 74 20 0a #!r6rs.(import . 0140: 20 20 28 72 6e 72 73 29 0a 20 20 28 72 6e 72 73 (rnrs). (rnrs 0150: 20 65 76 61 6c 29 0a 20 20 28 73 75 72 66 61 67 eval). (surfag 0160: 65 20 73 32 20 61 6e 64 2d 6c 65 74 29 0a 20 20 e s2 and-let). 0170: 28 73 75 72 66 61 67 65 20 73 37 38 20 6c 69 67 (surfage s78 lig 0180: 68 74 77 65 69 67 68 74 2d 74 65 73 74 69 6e 67 htweight-testing 0190: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ))..(define-synt 01a0: 61 78 20 65 78 70 65 63 74 0a 20 20 28 73 79 6e ax expect. (syn 01b0: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 tax-rules (). 01c0: 20 5b 28 5f 20 65 78 70 72 20 72 65 73 75 6c 74 [(_ expr result 01d0: 29 0a 20 20 20 20 20 28 63 68 65 63 6b 20 65 78 ). (check ex 01e0: 70 72 20 3d 3e 20 72 65 73 75 6c 74 29 5d 29 29 pr => result)])) 01f0: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 0200: 20 6d 75 73 74 2d 62 65 2d 61 2d 73 79 6e 74 61 must-be-a-synta 0210: 78 2d 65 72 72 6f 72 0a 20 20 28 73 79 6e 74 61 x-error. (synta 0220: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 5b x-rules (). [ 0230: 28 5f 20 65 78 70 72 29 0a 20 20 20 20 20 28 63 (_ expr). (c 0240: 68 65 63 6b 20 0a 20 20 20 20 20 20 20 28 67 75 heck . (gu 0250: 61 72 64 20 28 65 78 20 5b 23 74 20 28 73 79 6e ard (ex [#t (syn 0260: 74 61 78 2d 76 69 6f 6c 61 74 69 6f 6e 3f 20 65 tax-violation? e 0270: 78 29 5d 29 20 20 0a 20 20 20 20 20 20 20 20 20 x)]) . 0280: 28 65 76 61 6c 20 27 65 78 70 72 20 28 65 6e 76 (eval 'expr (env 0290: 69 72 6f 6e 6d 65 6e 74 20 27 28 72 6e 72 73 29 ironment '(rnrs) 02a0: 20 27 28 73 75 72 66 61 67 65 20 73 32 20 61 6e '(surfage s2 an 02b0: 64 2d 6c 65 74 29 29 29 29 0a 20 20 20 20 20 20 d-let)))). 02c0: 20 3d 3e 20 23 74 29 5d 29 29 0a 0a 3b 3b 20 54 => #t)]))..;; T 02d0: 61 6b 65 6e 20 73 74 72 61 69 67 68 74 20 66 72 aken straight fr 02e0: 6f 6d 20 74 68 65 20 72 65 66 65 72 65 6e 63 65 om the reference 02f0: 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 implementation 0300: 74 65 73 74 73 0a 0a 28 65 78 70 65 63 74 20 20 tests..(expect 0310: 28 61 6e 64 2d 6c 65 74 2a 20 28 29 20 31 29 20 (and-let* () 1) 0320: 31 29 0a 28 65 78 70 65 63 74 20 20 28 61 6e 64 1).(expect (and 0330: 2d 6c 65 74 2a 20 28 29 20 31 20 32 29 20 32 29 -let* () 1 2) 2) 0340: 0a 28 65 78 70 65 63 74 20 20 28 61 6e 64 2d 6c .(expect (and-l 0350: 65 74 2a 20 28 29 20 29 20 23 74 29 0a 0a 28 65 et* () ) #t)..(e 0360: 78 70 65 63 74 20 28 6c 65 74 20 28 28 78 20 23 xpect (let ((x # 0370: 66 29 29 20 28 61 6e 64 2d 6c 65 74 2a 20 28 78 f)) (and-let* (x 0380: 29 29 29 20 23 66 29 0a 28 65 78 70 65 63 74 20 ))) #f).(expect 0390: 28 6c 65 74 20 28 28 78 20 31 29 29 20 28 61 6e (let ((x 1)) (an 03a0: 64 2d 6c 65 74 2a 20 28 78 29 29 29 20 31 29 0a d-let* (x))) 1). 03b0: 28 65 78 70 65 63 74 20 28 61 6e 64 2d 6c 65 74 (expect (and-let 03c0: 2a 20 28 28 78 20 23 66 29 29 20 29 20 23 66 29 * ((x #f)) ) #f) 03d0: 0a 28 65 78 70 65 63 74 20 28 61 6e 64 2d 6c 65 .(expect (and-le 03e0: 74 2a 20 28 28 78 20 31 29 29 20 29 20 31 29 0a t* ((x 1)) ) 1). 03f0: 28 6d 75 73 74 2d 62 65 2d 61 2d 73 79 6e 74 61 (must-be-a-synta 0400: 78 2d 65 72 72 6f 72 20 28 61 6e 64 2d 6c 65 74 x-error (and-let 0410: 2a 20 28 20 23 66 20 28 78 20 31 29 29 29 20 29 * ( #f (x 1))) ) 0420: 0a 28 65 78 70 65 63 74 20 28 61 6e 64 2d 6c 65 .(expect (and-le 0430: 74 2a 20 28 20 28 23 66 29 20 28 78 20 31 29 29 t* ( (#f) (x 1)) 0440: 20 29 20 23 66 29 0a 28 6d 75 73 74 2d 62 65 2d ) #f).(must-be- 0450: 61 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 28 a-syntax-error ( 0460: 61 6e 64 2d 6c 65 74 2a 20 28 32 20 28 78 20 31 and-let* (2 (x 1 0470: 29 29 29 20 29 0a 28 65 78 70 65 63 74 20 28 61 ))) ).(expect (a 0480: 6e 64 2d 6c 65 74 2a 20 28 20 28 32 29 20 28 78 nd-let* ( (2) (x 0490: 20 31 29 29 20 29 20 31 29 0a 28 65 78 70 65 63 1)) ) 1).(expec 04a0: 74 20 28 61 6e 64 2d 6c 65 74 2a 20 28 20 28 78 t (and-let* ( (x 04b0: 20 31 29 20 28 32 29 29 20 29 20 32 29 0a 28 65 1) (2)) ) 2).(e 04c0: 78 70 65 63 74 20 28 6c 65 74 20 28 28 78 20 23 xpect (let ((x # 04d0: 66 29 29 20 28 61 6e 64 2d 6c 65 74 2a 20 28 78 f)) (and-let* (x 04e0: 29 20 78 29 29 20 23 66 29 0a 28 65 78 70 65 63 ) x)) #f).(expec 04f0: 74 20 28 6c 65 74 20 28 28 78 20 22 22 29 29 20 t (let ((x "")) 0500: 28 61 6e 64 2d 6c 65 74 2a 20 28 78 29 20 78 29 (and-let* (x) x) 0510: 29 20 22 22 29 0a 28 65 78 70 65 63 74 20 28 6c ) "").(expect (l 0520: 65 74 20 28 28 78 20 22 22 29 29 20 28 61 6e 64 et ((x "")) (and 0530: 2d 6c 65 74 2a 20 28 78 29 20 20 29 29 20 22 22 -let* (x) )) "" 0540: 29 0a 28 65 78 70 65 63 74 20 28 6c 65 74 20 28 ).(expect (let ( 0550: 28 78 20 31 29 29 20 28 61 6e 64 2d 6c 65 74 2a (x 1)) (and-let* 0560: 20 28 78 29 20 28 2b 20 78 20 31 29 29 29 20 32 (x) (+ x 1))) 2 0570: 29 0a 28 65 78 70 65 63 74 20 28 6c 65 74 20 28 ).(expect (let ( 0580: 28 78 20 23 66 29 29 20 28 61 6e 64 2d 6c 65 74 (x #f)) (and-let 0590: 2a 20 28 78 29 20 28 2b 20 78 20 31 29 29 29 20 * (x) (+ x 1))) 05a0: 23 66 29 0a 28 65 78 70 65 63 74 20 28 6c 65 74 #f).(expect (let 05b0: 20 28 28 78 20 31 29 29 20 28 61 6e 64 2d 6c 65 ((x 1)) (and-le 05c0: 74 2a 20 28 28 28 70 6f 73 69 74 69 76 65 3f 20 t* (((positive? 05d0: 78 29 29 29 20 28 2b 20 78 20 31 29 29 29 20 32 x))) (+ x 1))) 2 05e0: 29 0a 28 65 78 70 65 63 74 20 28 6c 65 74 20 28 ).(expect (let ( 05f0: 28 78 20 31 29 29 20 28 61 6e 64 2d 6c 65 74 2a (x 1)) (and-let* 0600: 20 28 28 28 70 6f 73 69 74 69 76 65 3f 20 78 29 (((positive? x) 0610: 29 29 20 29 29 20 23 74 29 0a 28 65 78 70 65 63 )) )) #t).(expec 0620: 74 20 28 6c 65 74 20 28 28 78 20 30 29 29 20 28 t (let ((x 0)) ( 0630: 61 6e 64 2d 6c 65 74 2a 20 28 28 28 70 6f 73 69 and-let* (((posi 0640: 74 69 76 65 3f 20 78 29 29 29 20 28 2b 20 78 20 tive? x))) (+ x 0650: 31 29 29 29 20 23 66 29 0a 28 65 78 70 65 63 74 1))) #f).(expect 0660: 20 28 6c 65 74 20 28 28 78 20 31 29 29 20 28 61 (let ((x 1)) (a 0670: 6e 64 2d 6c 65 74 2a 20 28 28 28 70 6f 73 69 74 nd-let* (((posit 0680: 69 76 65 3f 20 78 29 29 20 28 78 20 28 2b 20 78 ive? x)) (x (+ x 0690: 20 31 29 29 29 20 28 2b 20 78 20 31 29 29 29 20 1))) (+ x 1))) 06a0: 20 33 29 0a 3b 3b 20 54 68 69 73 20 6e 65 78 74 3).;; This next 06b0: 20 6f 6e 65 20 69 73 20 66 72 6f 6d 20 74 68 65 one is from the 06c0: 20 72 65 66 65 72 65 6e 63 65 20 69 6d 70 6c 65 reference imple 06d0: 6d 65 6e 74 61 74 69 6f 6e 20 74 65 73 74 73 0a mentation tests. 06e0: 3b 3b 20 62 75 74 20 49 20 63 61 6e 27 74 20 73 ;; but I can't s 06f0: 65 65 20 68 6f 77 20 69 74 20 22 6d 75 73 74 20 ee how it "must 0700: 62 65 20 61 20 73 79 6e 74 61 78 2d 65 72 72 6f be a syntax-erro 0710: 72 22 2e 0a 23 3b 28 6d 75 73 74 2d 62 65 2d 61 r"..#;(must-be-a 0720: 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 0a 20 20 -syntax-error. 0730: 28 6c 65 74 20 28 28 78 20 31 29 29 20 28 61 6e (let ((x 1)) (an 0740: 64 2d 6c 65 74 2a 20 28 28 28 70 6f 73 69 74 69 d-let* (((positi 0750: 76 65 3f 20 78 29 29 20 28 78 20 28 2b 20 78 20 ve? x)) (x (+ x 0760: 31 29 29 20 28 78 20 28 2b 20 78 20 31 29 29 29 1)) (x (+ x 1))) 0770: 20 28 2b 20 78 20 31 29 29 29 29 0a 0a 28 65 78 (+ x 1))))..(ex 0780: 70 65 63 74 20 28 6c 65 74 20 28 28 78 20 31 29 pect (let ((x 1) 0790: 29 20 28 61 6e 64 2d 6c 65 74 2a 20 28 78 20 28 ) (and-let* (x ( 07a0: 28 70 6f 73 69 74 69 76 65 3f 20 78 29 29 29 20 (positive? x))) 07b0: 28 2b 20 78 20 31 29 29 29 20 32 29 0a 28 65 78 (+ x 1))) 2).(ex 07c0: 70 65 63 74 20 28 6c 65 74 20 28 28 78 20 31 29 pect (let ((x 1) 07d0: 29 20 28 61 6e 64 2d 6c 65 74 2a 20 28 20 28 28 ) (and-let* ( (( 07e0: 62 65 67 69 6e 20 78 29 29 20 28 28 70 6f 73 69 begin x)) ((posi 07f0: 74 69 76 65 3f 20 78 29 29 29 20 28 2b 20 78 20 tive? x))) (+ x 0800: 31 29 29 29 20 32 29 0a 28 65 78 70 65 63 74 20 1))) 2).(expect 0810: 28 6c 65 74 20 28 28 78 20 30 29 29 20 28 61 6e (let ((x 0)) (an 0820: 64 2d 6c 65 74 2a 20 28 78 20 28 28 70 6f 73 69 d-let* (x ((posi 0830: 74 69 76 65 3f 20 78 29 29 29 20 28 2b 20 78 20 tive? x))) (+ x 0840: 31 29 29 29 20 23 66 29 0a 28 65 78 70 65 63 74 1))) #f).(expect 0850: 20 28 6c 65 74 20 28 28 78 20 23 66 29 29 20 28 (let ((x #f)) ( 0860: 61 6e 64 2d 6c 65 74 2a 20 28 78 20 28 28 70 6f and-let* (x ((po 0870: 73 69 74 69 76 65 3f 20 78 29 29 29 20 28 2b 20 sitive? x))) (+ 0880: 78 20 31 29 29 29 20 23 66 29 0a 28 65 78 70 65 x 1))) #f).(expe 0890: 63 74 20 28 6c 65 74 20 28 28 78 20 23 66 29 29 ct (let ((x #f)) 08a0: 20 28 61 6e 64 2d 6c 65 74 2a 20 28 20 28 28 62 (and-let* ( ((b 08b0: 65 67 69 6e 20 78 29 29 20 28 28 70 6f 73 69 74 egin x)) ((posit 08c0: 69 76 65 3f 20 78 29 29 29 20 28 2b 20 78 20 31 ive? x))) (+ x 1 08d0: 29 29 29 20 23 66 29 0a 0a 28 65 78 70 65 63 74 ))) #f)..(expect 08e0: 20 20 28 6c 65 74 20 28 28 78 20 31 29 29 20 28 (let ((x 1)) ( 08f0: 61 6e 64 2d 6c 65 74 2a 20 28 78 20 28 79 20 28 and-let* (x (y ( 0900: 2d 20 78 20 31 29 29 20 28 28 70 6f 73 69 74 69 - x 1)) ((positi 0910: 76 65 3f 20 79 29 29 29 20 28 2f 20 78 20 79 29 ve? y))) (/ x y) 0920: 29 29 20 23 66 29 0a 28 65 78 70 65 63 74 20 20 )) #f).(expect 0930: 28 6c 65 74 20 28 28 78 20 30 29 29 20 28 61 6e (let ((x 0)) (an 0940: 64 2d 6c 65 74 2a 20 28 78 20 28 79 20 28 2d 20 d-let* (x (y (- 0950: 78 20 31 29 29 20 28 28 70 6f 73 69 74 69 76 65 x 1)) ((positive 0960: 3f 20 79 29 29 29 20 28 2f 20 78 20 79 29 29 29 ? y))) (/ x y))) 0970: 20 23 66 29 0a 28 65 78 70 65 63 74 20 20 28 6c #f).(expect (l 0980: 65 74 20 28 28 78 20 23 66 29 29 20 28 61 6e 64 et ((x #f)) (and 0990: 2d 6c 65 74 2a 20 28 78 20 28 79 20 28 2d 20 78 -let* (x (y (- x 09a0: 20 31 29 29 20 28 28 70 6f 73 69 74 69 76 65 3f 1)) ((positive? 09b0: 20 79 29 29 29 20 28 2f 20 78 20 79 29 29 29 20 y))) (/ x y))) 09c0: 23 66 29 0a 28 65 78 70 65 63 74 20 20 28 6c 65 #f).(expect (le 09d0: 74 20 28 28 78 20 33 29 29 20 28 61 6e 64 2d 6c t ((x 3)) (and-l 09e0: 65 74 2a 20 28 78 20 28 79 20 28 2d 20 78 20 31 et* (x (y (- x 1 09f0: 29 29 20 28 28 70 6f 73 69 74 69 76 65 3f 20 79 )) ((positive? y 0a00: 29 29 29 20 28 2f 20 78 20 79 29 29 29 20 33 2f ))) (/ x y))) 3/ 0a10: 32 29 0a 0a 28 63 68 65 63 6b 2d 72 65 70 6f 72 2)..(check-repor 0a20: 74 29 0a t).