[uim-commit] r3009 - branches/r5rs/sigscheme/test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-27 18:53:15 -0800 (Fri, 27 Jan 2006)
New Revision: 3009

Modified:
   branches/r5rs/sigscheme/test/test-exp.scm
   branches/r5rs/sigscheme/test/test-list.scm
   branches/r5rs/sigscheme/test/test-srfi2.scm
   branches/r5rs/sigscheme/test/test-srfi38.scm
Log:
* sigscheme/test/test-exp.scm
* sigscheme/test/test-list.scm
* sigscheme/test/test-srfi2.scm
* sigscheme/test/test-srfi38.scm
  - Fix constant list mutation


Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2006-01-28 01:29:26 UTC (rev 3008)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2006-01-28 02:53:15 UTC (rev 3009)
@@ -957,8 +957,10 @@
 	 (set-cdr! rev-it reved)
 	 (null? rev-cdr))
        rev-it)))
-(assert-equal? "do test4" '(c b a) (nreverse '(a b c)))
-(assert-equal? "do test5" '((5 6) (3 4) (1 2)) (nreverse '((1 2) (3 4) (5 6))))
+(assert-equal? "do test4" '(c b a) (nreverse (list 'a 'b 'c)))
+(assert-equal? "do test5"
+               '((5 6) (3 4) (1 2))
+               (nreverse (list '(1 2) '(3 4) '(5 6))))
 
 ;; scm_s_do() has been changed as specified in R5RS. -- YamaKen 2006-01-11
 ;; R5RS: If no <expression>s are present, then the value of the `do' expression

Modified: branches/r5rs/sigscheme/test/test-list.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-list.scm	2006-01-28 01:29:26 UTC (rev 3008)
+++ branches/r5rs/sigscheme/test/test-list.scm	2006-01-28 02:53:15 UTC (rev 3009)
@@ -106,19 +106,22 @@
 (assert-equal? "reverse test2" '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
 
 ; list-tail
-(assert-equal? "list-tail test1" '(a b c) (list-tail '(a b c) 0))
-(assert-equal? "list-tail test2" '(b c) (list-tail '(a b c) 1))
-(assert-equal? "list-tail test3" '(c) (list-tail '(a b c) 2))
-(assert-equal? "list-tail test4" '() (list-tail '(a b c) 3))
-;;(assert-error  "list-tail test5" '() (list-tail '(a b c) 4))
-(assert-equal? "list-tail test6" '() (list-tail '() 0))
-;;(assert-error  "list-tail test7" (list-tail '() 1))
-(assert-eq?    "list-tail test8"  cdr0 (list-tail lst 0))
-(assert-eq?    "list-tail test9"  cdr1 (list-tail lst 1))
-(assert-eq?    "list-tail test10" cdr2 (list-tail lst 2))
-(assert-eq?    "list-tail test11" cdr3 (list-tail lst 3))
-(assert-eq?    "list-tail test12" nil  (list-tail lst 4))
-;;(assert-error  "list-tail test13" (list-tail lst 5))
+(tn "list-tail")
+(assert-equal? (tn) '(a b c) (list-tail '(a b c) 0))
+(assert-equal? (tn) '(b c) (list-tail '(a b c) 1))
+(assert-equal? (tn) '(c) (list-tail '(a b c) 2))
+(assert-equal? (tn) '() (list-tail '(a b c) 3))
+(assert-error  (tn) (lambda () (list-tail '(a b c) 4)))
+(assert-equal? (tn) '() (list-tail '() 0))
+(assert-error  (tn) (lambda () (list-tail '() 1)))
+(assert-error  (tn) (lambda () (list-tail '() -1)))
+(assert-eq?    (tn) cdr0 (list-tail lst 0))
+(assert-eq?    (tn) cdr1 (list-tail lst 1))
+(assert-eq?    (tn) cdr2 (list-tail lst 2))
+(assert-eq?    (tn) cdr3 (list-tail lst 3))
+(assert-eq?    (tn) nil  (list-tail lst 4))
+(assert-error  (tn) (lambda () (list-tail lst 5)))
+(assert-error  (tn) (lambda () (list-tail lst -1)))
 
 ; list-ref
 (assert-equal? "list-ref test1" 'c (list-ref '(a b c d) 2))
@@ -126,7 +129,7 @@
 (assert-eq?    "list-ref test3" elm1 (list-ref lst 1))
 (assert-eq?    "list-ref test4" elm2 (list-ref lst 2))
 (assert-eq?    "list-ref test5" elm3 (list-ref lst 3))
-;;(assert-error  "list-ref test6" (list-ref lst 4))
+(assert-error  "list-ref test6" (lambda () (list-ref lst 4)))
 
 ; memq
 (assert-equal? "memq test1" '(a b c) (memq 'a '(a b c)))
@@ -163,13 +166,13 @@
       (assert-equal? (tn) -4 (length* '(1 2 3 . 4)))
       (assert-equal? (tn) -5 (length* '(1 2 3 4 . 5)))
       (tn "length* circular list")
-      (define lst1 '(1))
+      (define lst1 (list 1))
       (set-cdr! lst1 lst1)
-      (define lst2 '(1 2))
+      (define lst2 (list 1 2))
       (set-cdr! (list-tail lst2 1) lst2)
-      (define lst3 '(1 2 3))
+      (define lst3 (list 1 2 3))
       (set-cdr! (list-tail lst3 2) lst3)
-      (define lst4 '(1 2 3 4))
+      (define lst4 (list 1 2 3 4))
       (set-cdr! (list-tail lst4 3) lst4)
       (assert-false (tn) (length* lst1))
       (assert-false (tn) (length* lst2))

Modified: branches/r5rs/sigscheme/test/test-srfi2.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi2.scm	2006-01-28 01:29:26 UTC (rev 3008)
+++ branches/r5rs/sigscheme/test/test-srfi2.scm	2006-01-28 02:53:15 UTC (rev 3009)
@@ -120,7 +120,7 @@
 (assert-false "and-let* #25" (and-let* (true
                                         even?
                                         ((integer? 1))
-                                        (foo #(1 2 3))
+                                        (foo '#(1 2 3))
                                         ((list? foo))
                                         (bar foo))
                                'ok))

Modified: branches/r5rs/sigscheme/test/test-srfi38.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi38.scm	2006-01-28 01:29:26 UTC (rev 3008)
+++ branches/r5rs/sigscheme/test/test-srfi38.scm	2006-01-28 02:53:15 UTC (rev 3009)
@@ -41,7 +41,7 @@
 
 (let* ((outs (open-output-string))
        (s "abc")
-       (convolution `(,s 1 #(,s b) (2) () ,s)))
+       (convolution `(,s 1 #(,s b) ,(list 2) () ,s)))
   ; go crazy with mutators
   (set-car! (cdr convolution) convolution)
   (vector-set! (caddr convolution) 1 (cddr convolution))
@@ -50,7 +50,7 @@
   (assert-equal? "srfi38 #1" "#1=(#2=\"abc\" . #3=(#1# . #4=(#(#2# #4#) (2 . #3#) () #2#)))" (get-output-string outs)))
 
 (let* ((outs (open-output-string))
-       (a-pair '(kar . kdr))
+       (a-pair (cons 'kar 'kdr))
             (convolution (eval (list 'lambda () a-pair) (scheme-report-environment 5))))
        (set-cdr! a-pair convolution)
        (write-with-shared-structure convolution outs)