1
;; Filename : test-letstar.scm
2
;; About : unit test for R5RS let*
4
;; Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
5
;; Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
7
;; All rights reserved.
9
;; Redistribution and use in source and binary forms, with or without
10
;; modification, are permitted provided that the following conditions
13
;; 1. Redistributions of source code must retain the above copyright
14
;; notice, this list of conditions and the following disclaimer.
15
;; 2. Redistributions in binary form must reproduce the above copyright
16
;; notice, this list of conditions and the following disclaimer in the
17
;; documentation and/or other materials provided with the distribution.
18
;; 3. Neither the name of authors nor the names of its contributors
19
;; may be used to endorse or promote products derived from this software
20
;; without specific prior written permission.
22
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23
;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24
;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
(load "./test/unittest.scm")
36
(define *test-track-progress* #f)
43
(tn "let* invalid form")
44
;; bindings and body required
45
(assert-error (tn) (lambda ()
47
(assert-error (tn) (lambda ()
49
(assert-error (tn) (lambda ()
51
(assert-error (tn) (lambda ()
53
(assert-error (tn) (lambda ()
55
(assert-error (tn) (lambda ()
57
(assert-error (tn) (lambda ()
59
(assert-error (tn) (lambda ()
61
(assert-error (tn) (lambda ()
63
;; bindings must be a list
64
(assert-error (tn) (lambda ()
66
(if (provided? "siod-bugs")
70
(assert-error (tn) (lambda ()
72
(assert-error (tn) (lambda ()
74
(assert-error (tn) (lambda ()
76
;; each binding must be a 2-elem list
77
(assert-error (tn) (lambda ()
79
(if (provided? "siod-bugs")
88
(let* ((a 1 'excessive)) 'val)))
91
(let* ((a 1) . (b 2)) 'val)))
94
(let* ((a . 1)) 'val)))
100
(let* ((a 1)) 'val . a)))
105
(tn "let* binding syntactic keyword")
106
(assert-equal? (tn) 4 (let* ((else 4)) else))
107
(assert-equal? (tn) 5 (let* ((=> 5)) =>))
108
(assert-equal? (tn) 6 (let* ((unquote 6)) unquote))
109
(assert-error (tn) (lambda () else))
110
(assert-error (tn) (lambda () =>))
111
(assert-error (tn) (lambda () unquote))
113
(tn "let* env isolation")
124
;; The environment is extended even if empty bindings on
125
;; !SCM_STRICT_DEFINE_PLACEMENT
133
(if (provided? "sigscheme")
137
(let* ((var1 (symbol-bound? 'var1 (%%current-environment)))
138
(var2 (symbol-bound? 'var1 (%%current-environment)))
139
(var3 (symbol-bound? 'var1 (%%current-environment))))
140
(list var1 var2 var3)))
143
(let* ((var1 (symbol-bound? 'var2 (%%current-environment)))
144
(var2 (symbol-bound? 'var2 (%%current-environment)))
145
(var3 (symbol-bound? 'var2 (%%current-environment))))
146
(list var1 var2 var3)))
149
(let* ((var1 (symbol-bound? 'var3 (%%current-environment)))
150
(var2 (symbol-bound? 'var3 (%%current-environment)))
151
(var3 (symbol-bound? 'var3 (%%current-environment))))
152
(list var1 var2 var3)))))
154
(tn "let* internal definitions lacking sequence part")
155
;; at least one <expression> is required
163
(define (proc1) 1))))
173
(define (proc2) 2))))
178
(define (proc2) 2))))
197
(define (proc1) 1)))))
209
(define (proc2) 2)))))
215
(define (proc2) 2)))))
222
;; appending a non-definition expression into a begin block is invalid
264
(tn "let* internal definitions cross reference")
265
;; R5RS: 5.2.2 Internal definitions
266
;; Just as for the equivalent `letrec' expression, it must be possible to
267
;; evaluate each <expression> of every internal definition in a <body> without
268
;; assigning or referring to the value of any <variable> being defined.
296
(list var1 var2 var3 var4 var5)))
299
(let* ((var0 (symbol-bound? 'var1)))
300
(define var1 (symbol-bound? 'var1))
301
(define var2 (symbol-bound? 'var1))
303
(define var3 (symbol-bound? 'var1))
305
(define var4 (symbol-bound? 'var1))))
306
(define var5 (symbol-bound? 'var1))
307
(list var0 var1 var2 var3 var4 var5)))
310
(let* ((var0 (symbol-bound? 'var2)))
311
(define var1 (symbol-bound? 'var2))
312
(define var2 (symbol-bound? 'var2))
314
(define var3 (symbol-bound? 'var2))
316
(define var4 (symbol-bound? 'var2))))
317
(define var5 (symbol-bound? 'var2))
318
(list var0 var1 var2 var3 var4 var5)))
321
(let* ((var0 (symbol-bound? 'var3)))
322
(define var1 (symbol-bound? 'var3))
323
(define var2 (symbol-bound? 'var3))
325
(define var3 (symbol-bound? 'var3))
327
(define var4 (symbol-bound? 'var3))))
328
(define var5 (symbol-bound? 'var3))
329
(list var0 var1 var2 var3 var4 var5)))
332
(let* ((var0 (symbol-bound? 'var4)))
333
(define var1 (symbol-bound? 'var4))
334
(define var2 (symbol-bound? 'var4))
336
(define var3 (symbol-bound? 'var4))
338
(define var4 (symbol-bound? 'var4))))
339
(define var5 (symbol-bound? 'var4))
340
(list var0 var1 var2 var3 var4 var5)))
343
(let* ((var0 (symbol-bound? 'var5)))
344
(define var1 (symbol-bound? 'var5))
345
(define var2 (symbol-bound? 'var5))
347
(define var3 (symbol-bound? 'var5))
349
(define var4 (symbol-bound? 'var5))))
350
(define var5 (symbol-bound? 'var5))
351
(list var0 var1 var2 var3 var4 var5)))
352
;; outer let cannot refer internal variable
355
(let* ((var0 (lambda () var1)))
356
(define var1 (lambda () 1))
358
;; defining procedure can refer other (and self) variables as if letrec
361
(let* ((var0 (lambda () 0)))
362
(define var1 (lambda () var0))
363
(define var2 (lambda () var0))
365
(define var3 (lambda () var0))
367
(define var4 (lambda () var0))))
368
(define var5 (lambda () var0))
369
(list (eq? (var1) var0)
377
(define var1 (lambda () var1))
378
(define var2 (lambda () var1))
380
(define var3 (lambda () var1))
382
(define var4 (lambda () var1))))
383
(define var5 (lambda () var1))
384
(list (eq? (var1) var1)
392
(define var1 (lambda () var2))
393
(define var2 (lambda () var2))
395
(define var3 (lambda () var2))
397
(define var4 (lambda () var2))))
398
(define var5 (lambda () var2))
399
(list (eq? (var1) var2)
407
(define var1 (lambda () var3))
408
(define var2 (lambda () var3))
410
(define var3 (lambda () var3))
412
(define var4 (lambda () var3))))
413
(define var5 (lambda () var3))
414
(list (eq? (var1) var3)
422
(define var1 (lambda () var4))
423
(define var2 (lambda () var4))
425
(define var3 (lambda () var4))
427
(define var4 (lambda () var4))))
428
(define var5 (lambda () var4))
429
(list (eq? (var1) var4)
437
(define var1 (lambda () var5))
438
(define var2 (lambda () var5))
440
(define var3 (lambda () var5))
442
(define var4 (lambda () var5))))
443
(define var5 (lambda () var5))
444
(list (eq? (var1) var5)
450
(tn "let* internal definitions valid forms")
451
;; valid internal definitions
473
(list (proc1) (proc2))))
479
(list var1 (proc2))))
485
(list (proc1) var2)))
486
;; SigScheme accepts '(begin)' as valid internal definition '(begin
487
;; <definition>*)' as defined in "7.1.6 Programs and definitions" of R5RS
488
;; although it is rejected as expression '(begin <sequence>)' as defined in
489
;; "7.1.3 Expressions".
527
(list (proc1) (proc2))))
534
(list var1 (proc2))))
541
(list (proc1) var2)))
557
;; begin block and single definition mixed
582
(tn "let* internal definitions invalid begin blocks")
583
;; appending a non-definition expression into a begin block is invalid
613
(list (proc1) (proc2)))))
621
(list var1 (proc2)))))
629
(list (proc1) var2))))
647
(tn "let* internal definitions invalid placement")
648
;; a non-definition expression prior to internal definition is invalid
658
(define (proc1) 1))))
670
(define (proc2) 2))))
676
(define (proc2) 2))))
699
(define (proc1) 1)))))
713
(define (proc2) 2)))))
720
(define (proc2) 2)))))
740
(define var6 6)))))))
753
(define var6 6)))))))
754
;; a non-definition expression prior to internal definition is invalid even if
755
;; expression(s) is following the internal definition
865
(tn "let* binding syntactic keywords")
912
(let* ((syn quasiquote))
916
(let* ((syn unquote))
920
(let* ((syn unquote-splicing))
925
;; empty bindings is allowed by the formal syntax spec
929
;; duplicate variable name is allowd on let*
935
;; masked variable name
943
(list var1 var2 var3))))
952
(list var1 var2 var3)))
960
(set! var3 (+ var1 var2)))
961
(list var1 var2 var3)))
971
(set! var3 (+ var1 var2)))
972
(list var1 var2 var3)))
978
(var4 (let* ((var1 4)
983
(list var1 var2 var3))))
984
(list var1 var2 var3 var4)))
991
(list var1 var2 var3)))
993
(tn "let* lexical scope")
995
(let* ((count-let* 0)) ;; intentionally same name
997
(set! count-let* (+ count-let* 1))
999
(assert-true (tn) (procedure? count-let*))
1000
(assert-equal? (tn) 1 (count-let*))
1001
(assert-equal? (tn) 2 (count-let*))
1002
(assert-equal? (tn) 3 (count-let*))
added
removed
sigscheme/test/test-letstar.scm
