srfi-19: Fix `string->date' weekday lookup.

[bpt/guile.git] / test-suite / tests / syntax.test

diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 9b3432a..1277e52 100644 (file)
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,6 +1,6 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2005, 2006 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -14,8 +14,8 @@
 ;;;; 
 ;;;; You should have received a copy of the GNU General Public License
 ;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-syntax)
   :use-module (test-suite lib))
@@ -430,7 +430,7 @@
   (with-test-prefix "bindings"
 
     (pass-if-exception "initial bindings are undefined"
-      exception:unbound-var
+      exception:used-before-defined
       (let ((x 1))
        (letrec ((x 1) (y x)) y))))
 
@@ -557,6 +557,50 @@
         (let ((=> 'foo))
           (eq? (cond (else => identity)) identity)))))
 
+  (with-test-prefix "SRFI-61"
+
+    (pass-if "always available"
+      (cond-expand (srfi-61 #t) (else #f)))
+
+    (pass-if "single value consequent"
+      (eq? 'ok (cond (#t identity => (lambda (x) 'ok)) (else #f))))
+
+    (pass-if "single value alternate"
+      (eq? 'ok (cond (#t not => (lambda (x) #f)) (else 'ok))))
+
+    (pass-if-exception "doesn't affect standard =>"
+      exception:wrong-num-args
+      (cond ((values 1 2) => (lambda (x y) #t))))
+
+    (pass-if "multiple values consequent"
+      (equal? '(2 1) (cond ((values 1 2)
+                           (lambda (one two)
+                             (and (= 1 one) (= 2 two))) =>
+                           (lambda (one two) (list two one)))
+                          (else #f))))
+
+    (pass-if "multiple values alternate"
+      (eq? 'ok (cond ((values 2 3 4)
+                     (lambda args (equal? '(1 2 3) args)) =>
+                     (lambda (x y z) #f))
+                    (else 'ok))))
+
+    (pass-if "zero values"
+      (eq? 'ok (cond ((values) (lambda () #t) => (lambda () 'ok))
+                    (else #f))))
+
+    (pass-if "bound => is handled correctly"
+      (let ((=> 'ok))
+       (eq? 'ok (cond (#t identity =>) (else #f)))))
+
+    (pass-if-exception "missing recipient"
+      '(syntax-error . "Missing recipient")
+      (cond (#t identity =>)))
+
+    (pass-if-exception "extra recipient"
+      '(syntax-error . "Extra expression")
+      (cond (#t identity => identity identity))))
+
   (with-test-prefix "unmemoization"
 
     (pass-if "normal clauses"
@@ -725,15 +769,16 @@
 
 (with-test-prefix "top-level define"
 
-  (pass-if "binding is created before expression is evaluated"
-    (= (eval '(begin
-                (define foo
-                  (begin
-                    (set! foo 1)
-                    (+ foo 1)))
-                foo)
-             (interaction-environment))
-       2))
+  (pass-if "redefinition"
+    (let ((m (make-module)))
+      (beautify-user-module! m)
+
+      ;; The previous value of `round' must still be visible at the time the
+      ;; new `round' is defined.  According to R5RS (Section 5.2.1), `define'
+      ;; should behave like `set!' in this case (except that in the case of
+      ;; Guile, we respect module boundaries).
+      (eval '(define round round) m)
+      (eq? (module-ref m 'round) round)))
 
   (with-test-prefix "currying"
 
@@ -743,6 +788,24 @@
                ((foo)))
             (interaction-environment))))
 
+  (with-test-prefix "unmemoization"
+
+    (pass-if "definition unmemoized without prior execution"
+      (eval '(begin 
+               (define (blub) (cons ('(1 . 2)) 2))
+               (equal?
+                 (procedure-source blub)
+                 '(lambda () (cons ('(1 . 2)) 2))))
+            (interaction-environment)))
+
+    (pass-if "definition with documentation unmemoized without prior execution"
+      (eval '(begin 
+               (define (blub) "Comment" (cons ('(1 . 2)) 2))
+               (equal?
+                 (procedure-source blub)
+                 '(lambda () "Comment" (cons ('(1 . 2)) 2))))
+            (interaction-environment))))
+
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
@@ -762,6 +825,17 @@
                   (eq? 'c (a 2) (a 5))))
           (interaction-environment)))
 
+  (pass-if "binding is created before expression is evaluated"
+    ;; Internal defines are equivalent to `letrec' (R5RS, Section 5.2.2).
+    (= (eval '(let ()
+                (define foo
+                  (begin
+                    (set! foo 1)
+                    (+ foo 1)))
+                foo)
+             (interaction-environment))
+       2))
+
   (pass-if "internal defines with begin"
     (false-if-exception
      (eval '(let ((a identity) (b identity) (c identity))
@@ -950,19 +1024,26 @@
     ;; an environment with no bindings at all
     (define empty-environment
       (make-module 1))
+
+    ;; these tests are 'unresolved because to work with ice-9 syncase it was
+    ;; necessary to drop the unquote from `do' in the implementation, and
+    ;; unfortunately that makes `while' depend on its evaluation environment
       
     (pass-if "empty body"
+      (throw 'unresolved)
       (eval `(,while #f)
            empty-environment)
       #t)
     
     (pass-if "initially false"
+      (throw 'unresolved)
       (eval `(,while #f
               #f)
            empty-environment)
       #t)
     
     (pass-if "iterating"
+      (throw 'unresolved)
       (let ((cond (make-iterations-cond 3)))
        (eval `(,while (,cond)
                 123 456)