* tests/syntax.test: Added some tests, updated some others with

respect to recent changes in eval.c.  Further, extracted test
cases for guile's extended set! functionality to srfi-17.test.

* tests/srfi-17.test:  New file.

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index b91212d..9f68932 100644 (file)
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,11 @@
+2001-11-17  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * tests/syntax.test: Added some tests, updated some others with
+       respect to recent changes in eval.c.  Further, extracted test
+       cases for guile's extended set! functionality to srfi-17.test.
+
+       * tests/srfi-17.test:  New file.
+
 2001-11-04  Stefan Jahn  <stefan@lkcc.org>
 
        * tests/ports.test: Run (close-port) before (delete-file) if

diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test
new file mode 100644 (file)
index 0000000..dc6fd7e
--- /dev/null
+++ b/test-suite/tests/srfi-17.test
@@ -0,0 +1,32 @@
+;;;; srfi-17.test --- test suite for Guile's SRFI-17 functions. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2001 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
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; 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
+
+(use-modules (srfi srfi-17))
+
+(with-test-prefix "set!"
+
+  (with-test-prefix "target is not procedure with setter"
+
+    (pass-if-exception "(set! (symbol->string 'x) 1)"
+      exception:wrong-type-arg
+      (set! (symbol->string 'x) 1))
+
+    (pass-if-exception "(set! '#f 1)"
+      exception:wrong-type-arg
+      (set! '#f 1))))

diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 2c5f06b..14836fb 100644 (file)
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -51,6 +51,34 @@
       exception:missing/extra-expr
       ())))
 
+(with-test-prefix "quote"
+  #t)
+
+(with-test-prefix "quasiquote"
+
+  (with-test-prefix "unquote"
+
+    (pass-if "repeated execution"
+      (let ((foo (let ((i 0)) (lambda () (set! i (+ i 1)) `(,i)))))
+       (and (equal? (foo) '(1)) (equal? (foo) '(2))))))
+
+  (with-test-prefix "unquote-splicing"
+
+    (pass-if-exception "extra arguments"
+      exception:missing/extra-expr
+      (quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
+
+(with-test-prefix "begin"
+
+  (pass-if "legal (begin)"
+    (begin)
+    #t)
+
+  (expect-fail-exception "illegal (begin)"
+    exception:bad-body
+    (if #t (begin))
+    #t))
+
 (with-test-prefix "lambda"
 
   (with-test-prefix "bad formals"
@@ -63,10 +91,6 @@
       exception:bad-formals
       (lambda . "foo"))
 
-    (pass-if-exception "(lambda ())"
-      exception:bad-formals
-      (lambda ()))
-
     (pass-if-exception "(lambda \"foo\")"
       exception:bad-formals
       (lambda "foo"))
@@ -101,7 +125,13 @@
     ;; Fixed on 2001-3-3
     (pass-if-exception "(lambda (x x x) 1)"
       exception:duplicate-formals
-      (lambda (x x x) 1))))
+      (lambda (x x x) 1)))
+
+  (with-test-prefix "bad body"
+
+    (pass-if-exception "(lambda ())"
+      exception:bad-body
+      (lambda ()))))
 
 (with-test-prefix "let"
 
@@ -111,35 +141,25 @@
       exception:unbound-var
       (let ((x 1) (y x)) y)))
 
-  (with-test-prefix "bad body"
-
-    (pass-if-exception "(let ())"
-      exception:bad-body
-      (let ()))
-
-    (pass-if-exception "(let ((x 1)))"
-      exception:bad-body
-      (let ((x 1))))
+  (with-test-prefix "bad bindings"
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let)"
-      exception:bad-body
+      exception:bad-bindings
       (let))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let 1)"
-      exception:bad-body
+      exception:bad-bindings
       (let 1))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let (x))"
-      exception:bad-body
-      (let (x))))
+      exception:bad-bindings
+      (let (x)))
 
-  (with-test-prefix "bad bindings"
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    ;; (Even although the body is bad as well...)
+    (pass-if-exception "(let ((x)))"
+      exception:bad-body
+      (let ((x))))
 
     (pass-if-exception "(let (x) 1)"
       exception:bad-bindings
@@ -161,10 +181,32 @@
 
     (pass-if-exception "(let ((x 1) (x 2)) x)"
       exception:duplicate-bindings
-      (let ((x 1) (x 2)) x))))
+      (let ((x 1) (x 2)) x)))
+
+  (with-test-prefix "bad body"
+
+    (pass-if-exception "(let ())"
+      exception:bad-body
+      (let ()))
+
+    (pass-if-exception "(let ((x 1)))"
+      exception:bad-body
+      (let ((x 1))))))
 
 (with-test-prefix "named let"
 
+  (with-test-prefix "initializers"
+
+    (pass-if "evaluated in outer environment"
+      (let ((f -))
+       (eqv? (let f ((n (f 1))) n) -1))))
+
+  (with-test-prefix "bad bindings"
+
+    (pass-if-exception "(let x (y))"
+      exception:bad-bindings
+      (let x (y))))
+
   (with-test-prefix "bad body"
 
     (pass-if-exception "(let x ())"
@@ -173,13 +215,7 @@
 
     (pass-if-exception "(let x ((y 1)))"
       exception:bad-body
-      (let x ((y 1))))
-
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
-    (pass-if-exception "(let x (y))"
-      exception:bad-body
-      (let x (y)))))
+      (let x ((y 1))))))
 
 (with-test-prefix "let*"
 
@@ -193,35 +229,19 @@
       (let* ((x 1) (x x))
        (= x 1))))
 
-  (with-test-prefix "bad body"
-
-    (pass-if-exception "(let* ())"
-      exception:bad-body
-      (let* ()))
-
-    (pass-if-exception "(let* ((x 1)))"
-      exception:bad-body
-      (let* ((x 1))))
+  (with-test-prefix "bad bindings"
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let*)"
-      exception:bad-body
+      exception:bad-bindings
       (let*))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let* 1)"
-      exception:bad-body
+      exception:bad-bindings
       (let* 1))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(let* (x))"
-      exception:bad-body
-      (let* (x))))
-
-  (with-test-prefix "bad bindings"
+      exception:bad-bindings
+      (let* (x)))
 
     (pass-if-exception "(let* (x) 1)"
       exception:bad-bindings
@@ -245,7 +265,17 @@
 
     (pass-if-exception "(let* ((1 2)) 3)"
       exception:bad-var
-      (let* ((1 2)) 3))))
+      (let* ((1 2)) 3)))
+
+  (with-test-prefix "bad body"
+
+    (pass-if-exception "(let* ())"
+      exception:bad-body
+      (let* ()))
+
+    (pass-if-exception "(let* ((x 1)))"
+      exception:bad-body
+      (let* ((x 1))))))
 
 (with-test-prefix "letrec"
 
@@ -256,35 +286,19 @@
       (let ((x 1))
        (letrec ((x 1) (y x)) y))))
 
-  (with-test-prefix "bad body"
-
-    (pass-if-exception "(letrec ())"
-      exception:bad-body
-      (letrec ()))
-
-    (pass-if-exception "(letrec ((x 1)))"
-      exception:bad-body
-      (letrec ((x 1))))
+  (with-test-prefix "bad bindings"
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(letrec)"
-      exception:bad-body
+      exception:bad-bindings
       (letrec))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(letrec 1)"
-      exception:bad-body
+      exception:bad-bindings
       (letrec 1))
 
-    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
-    ;; Hmm, the body is bad as well, isn't it?
     (pass-if-exception "(letrec (x))"
-      exception:bad-body
-      (letrec (x))))
-
-  (with-test-prefix "bad bindings"
+      exception:bad-bindings
+      (letrec (x)))
 
     (pass-if-exception "(letrec (x) 1)"
       exception:bad-bindings
@@ -314,7 +328,17 @@
 
     (pass-if-exception "(letrec ((x 1) (x 2)) x)"
       exception:duplicate-bindings
-      (letrec ((x 1) (x 2)) x))))
+      (letrec ((x 1) (x 2)) x)))
+
+  (with-test-prefix "bad body"
+
+    (pass-if-exception "(letrec ())"
+      exception:bad-body
+      (letrec ()))
+
+    (pass-if-exception "(letrec ((x 1)))"
+      exception:bad-body
+      (letrec ((x 1))))))
 
 (with-test-prefix "if"
 
@@ -445,6 +469,12 @@
 
 (with-test-prefix "define"
 
+  (with-test-prefix "currying"
+
+    (pass-if "(define ((foo)) #f)"
+      (define ((foo)) #t)
+      ((foo))))
+
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
@@ -489,18 +519,6 @@
       exception:bad-var
       (set! #\space #f))))
 
-(with-test-prefix "generalized set! (SRFI 17)"
-
-  (with-test-prefix "target is not procedure with setter"
-
-    (pass-if-exception "(set! (symbol->string 'x) 1)"
-      exception:wrong-type-arg
-      (set! (symbol->string 'x) 1))
-
-    (pass-if-exception "(set! '#f 1)"
-      exception:wrong-type-arg
-      (set! '#f 1))))
-
 (with-test-prefix "quote"
 
   (with-test-prefix "missing or extra expression"