[uim-commit] r2898 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-13 00:00:58 -0800 (Fri, 13 Jan 2006)
New Revision: 2898

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/test/test-define.scm
Log:
* sigscheme/test/test-define.scm
  - Add tests for internal definitions
* sigscheme/TODO
  - Update


Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO	2006-01-13 06:40:24 UTC (rev 2897)
+++ branches/r5rs/sigscheme/TODO	2006-01-13 08:00:58 UTC (rev 2898)
@@ -1,6 +1,14 @@
 ==============================================================================
 Requirements and critical bugs:
 
+* Write test for tail expression of all tail-recursive syntaxes (and make
+  "internal defintions #4" of test-define.scm passed)
+
+* Confirm internal definition behavior as specification
+  - Make all test in test-define.scm passed when SCM_STRICT_ARGCHECK
+
+* Confirm R5RS and SRFI conformance for each function implementation
+
 * Autoconfiscate the SigScheme package (don't rely on uim's configure)
   - Prepare replace functions (asprintf and so on)
   - Introduce C99-independent stdint.h

Modified: branches/r5rs/sigscheme/test/test-define.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-define.scm	2006-01-13 06:40:24 UTC (rev 2897)
+++ branches/r5rs/sigscheme/test/test-define.scm	2006-01-13 08:00:58 UTC (rev 2898)
@@ -122,6 +122,153 @@
 
 (assert-equal? "internal define2" 17 (idefine0 0))
 
+(if (or (symbol-bound? 'f)
+        (symbol-bound? 'x)
+        (symbol-bound? 'y)
+        (symbol-bound? 'foo)
+        (symbol-bound? 'bar))
+    (error "global variables for internal definitions tests are tainted"))
+
+(tn "internal defintions")
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ (let ()
+                      (define x 6)
+                      (+ x 3))
+                    x)))
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ (let* ()
+                      (define x 6)
+                      (+ x 3))
+                    x)))
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ (letrec ()
+                      (define x 6)
+                      (+ x 3))
+                    x)))
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ (begin
+                      (define x 6)
+                      (+ x 3))
+                    x)))
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ ((lambda ()
+                       (define x 6)
+                       (+ x 3)))
+                    x)))
+(assert-equal? (tn)
+               14
+               (let ((x 5))
+                 (+ (begin
+                      (define (f)
+                        (define x 6)
+                        (+ x 3))
+                      (f))
+                    x)))
+
+(tn "internal defintions: letrec-like behavior")
+(assert-equal? (tn)
+               45
+               (let ((x 5))
+                 (define foo (lambda (y) (bar x y)))
+                 (define bar (lambda (a b) (+ (* a b) a)))
+                 (foo (+ x 3))))
+(assert-equal? (tn)
+               45
+               (let ((x 5))
+                 (define bar (lambda (a b) (+ (* a b) a)))
+                 (define foo (lambda (y) (bar x y)))
+                 (foo (+ x 3))))
+(assert-error (tn)
+               (lambda ()
+                 (let ((x 5))
+                   (define foo bar)
+                   (define bar (lambda (a b) (+ (* a b) a)))
+                   (foo x (+ x 3)))))
+(assert-error  (tn)
+               (lambda ()
+                 (let ((x 5))
+                   (define bar (lambda (a b) (+ (* a b) a)))
+                   (define foo bar)
+                   (foo x (+ x 3)))))
+(assert-error  (tn)
+               (lambda ()
+                 (let ()
+                   (define foo 1)
+                   (define bar (+ foo 1))
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (let ()
+                   (define bar (+ foo 1))
+                   (define foo 1)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (let ((foo 3))
+                   (define foo 1)
+                   (define bar (+ foo 1))
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (let ((foo 3))
+                   (define bar (+ foo 1))
+                   (define foo 1)
+                   (+ foo bar))))
+
+(tn "internal defintions: non-beginning of block")
+(assert-error  (tn)
+               (lambda ()
+                 (let ()
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (let* ()
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (letrec ()
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (begin
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (lambda ()
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+(assert-error  (tn)
+               (lambda ()
+                 (define (f)
+                   (define foo 1)
+                   (set! foo 5)
+                   (define bar 2)
+                   (+ foo bar))))
+
 ; set!
 (define (set-dot a . b)
   (set! b '(1 2))