From 08c608e10a30e318732c52354e918fca16418786 Mon Sep 17 00:00:00 2001
From: Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
Date: Fri, 2 Mar 2001 01:38:01 +0000
Subject: [PATCH] * extracted the tests from exceptions.test into eval.test and
 syntax.test. * added a few test cases.

---
 test-suite/ChangeLog             |  53 +++--
 test-suite/lib.scm               |   7 +-
 test-suite/tests/eval.test       |  58 +++++
 test-suite/tests/exceptions.test | 273 +++------------------
 test-suite/tests/r4rs.test       |   6 +
 test-suite/tests/syntax.test     | 397 +++++++++++++++++++++++++++++++
 6 files changed, 539 insertions(+), 255 deletions(-)
 create mode 100644 test-suite/tests/syntax.test

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index 58d730c03..e69a9af32 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,44 +1,65 @@
 2001-03-01  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
-	* exceptions.test, numbers.test:  Moved the number related test
-	cases from exceptions.test to numbers.test.
+	* lib.scm (exception:unbound-var, exception:wrong-num-args):  New
+	exported constants.
 
-	* numbers.test:  Added a test case.
+	* tests/r4rs.test:  Make sure that no bindings for x and y exist
+	after the file is loaded.
+
+	* tests/syntax.test:  New file.
+
+	* tests/exceptions.test, tests/syntax.test, tests/eval.test:
+	Moved the test cases that are related to guile's syntactic forms
+	from tests/exceptions.test to tests/syntax.test.  Moved tests
+	related to evaluation and application to tests/eval.test.
+
+	* tests/exceptions.test:  Added some test cases that check guile's
+	exception handling.
 
 2001-03-01  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
-	* symbols.test:  New file.
+	* tests/exceptions.test, tests/numbers.test:  Moved the number
+	related test cases from tests/exceptions.test to
+	tests/numbers.test.
+
+	* tests/numbers.test:  Added a test case.
+
+2001-03-01  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* tests/symbols.test:  New file.
 
 	(exception:immutable-string):  New constant.  Currently, this is a
 	dummy since guile does not have immutable strings.
 
-	* exceptions.test, strings.test, symbols.test:  Moved the string
-	related test cases from exceptions.test to strings.test and the
-	symbol related test cases to symbols.test.
+	* tests/exceptions.test, tests/strings.test, tests/symbols.test:
+	Moved the string related test cases from tests/exceptions.test to
+	tests/strings.test and the symbol related test cases to
+	tests/symbols.test.
 
-	* strings.test:  Copyright notice updated.  Added a couple of test
-	cases.
+	* tests/strings.test:  Copyright notice updated.  Added a couple
+	of test cases.
 
 	(exception:immutable-string):  New constant.  Currently, this is a
 	dummy since guile does not have immutable strings.
 
 2001-02-28  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
-	* exceptions.test:  Use expect-fail-exception to indicate test
-	cases where exceptions should occur, but don't.
+	* tests/exceptions.test:  Use expect-fail-exception to indicate
+	test cases where exceptions should occur, but don't.
 
 	(exception:bad-bindings, exception:bad-formals, exception:bad-var,
 	exception:missing/extra-expr):  New constants.
 
 2001-02-28  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
-	* reader.test, exceptions.test:  Moved the reader related test
-	cases from exceptions.test to reader.test.
+	* tests/reader.test, tests/exceptions.test:  Moved the reader
+	related test cases from tests/exceptions.test to
+	tests/reader.test.
 
-	* reader.test (exception:eof, exception:unexpected-rparen):  New
-	constants.
+	* tests/reader.test (exception:eof, exception:unexpected-rparen):
+	New constants.
 
-	* exceptions.test (read-string, x:eof, x:unexpected-rparen):
+	* tests/exceptions.test (read-string, x:eof, x:unexpected-rparen):
 	Removed.
 
 2001-02-28  Dirk Herrmann  <D.Herrmann@tu-bs.de>
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 7c8436450..6cc48f24d 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -22,7 +22,8 @@
 (export
 
  ;; Exceptions which are commonly being tested for.
- exception:out-of-range exception:wrong-type-arg
+ exception:out-of-range exception:unbound-var
+ exception:wrong-num-args exception:wrong-type-arg
 
  ;; Reporting passes and failures.
  run-test
@@ -219,6 +220,10 @@
 ;;; Define some exceptions which are commonly being tested for.
 (define exception:out-of-range
   (cons 'out-of-range "^Argument .*out of range"))
+(define exception:unbound-var
+  (cons 'unbound-variable "^Unbound variable"))
+(define exception:wrong-num-args
+  (cons 'wrong-number-of-args "^Wrong number of arguments"))
 (define exception:wrong-type-arg
   (cons 'wrong-type-arg "^Wrong type argument"))
 
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index c06542f06..533b564bc 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -57,6 +57,20 @@
 
 (with-test-prefix "evaluator"
 
+  (with-test-prefix "symbol lookup"
+
+    (with-test-prefix "top level"
+
+      (with-test-prefix "unbound"
+
+	(pass-if-exception "variable reference"
+	  exception:unbound-var
+	  x)
+
+	(pass-if-exception "procedure"
+	  exception:unbound-var
+	  (x)))))
+
   (with-test-prefix "parameter error"
 
     ;; This is currently a bug in guile:
@@ -77,6 +91,50 @@
 
     ))
 
+;;;
+;;; apply
+;;;
+
+(with-test-prefix "application"
+
+  (with-test-prefix "wrong number of arguments"
+
+    (pass-if-exception "((lambda () #f) 1)"
+      exception:wrong-num-args
+      ((lambda () #f) 1))
+
+    (pass-if-exception "((lambda (x) #f))"
+      exception:wrong-num-args
+      ((lambda (x) #f)))
+
+    (pass-if-exception "((lambda (x) #f) 1 2)"
+      exception:wrong-num-args
+      ((lambda (x) #f) 1 2))
+
+    (pass-if-exception "((lambda (x y) #f))"
+      exception:wrong-num-args
+      ((lambda (x y) #f)))
+
+    (pass-if-exception "((lambda (x y) #f) 1)"
+      exception:wrong-num-args
+      ((lambda (x y) #f) 1))
+
+    (pass-if-exception "((lambda (x y) #f) 1 2 3)"
+      exception:wrong-num-args
+      ((lambda (x y) #f) 1 2 3))
+
+    (pass-if-exception "((lambda (x . rest) #f))"
+      exception:wrong-num-args
+      ((lambda (x . rest) #f)))
+
+    (pass-if-exception "((lambda (x y . rest) #f))"
+      exception:wrong-num-args
+      ((lambda (x y . rest) #f)))
+
+    (pass-if-exception "((lambda (x y . rest) #f) 1)"
+      exception:wrong-num-args
+      ((lambda (x y . rest) #f) 1))))
+
 ;;;
 ;;; map
 ;;;
diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test
index 91cf539e2..6e3c0d9cd 100644
--- a/test-suite/tests/exceptions.test
+++ b/test-suite/tests/exceptions.test
@@ -1,4 +1,4 @@
-;;;; exceptions.test                                            -*- scheme -*-
+;;;; exceptions.test --- tests for Guile's exception handling  -*- scheme -*-
 ;;;; Copyright (C) 2001 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
@@ -40,250 +40,47 @@
 ;;;; whether to permit this exception to apply to your modifications.
 ;;;; If you do not wish that, delete this exception notice.
 
-;;;; Commentary:
 
-;;; All tests should use `expect-exception' (aliased to `goad' for
-;;; brevity).  Tests that fail (i.e., do NOT cause exception should be
-;;; marked with a preceding line "no exception on DATE", where DATE is
-;;; when you found the failure.  If guile is fixed so that the test
-;;; passes, do not delete the comment, but instead append "fixed on
-;;; DATE" w/ the fix date.  If the test itself changes (due to a change
-;;; in the specification, for example), append "test amended on DATE"
-;;; and some explanatory text.  You can delete comments (and move the
-;;; test up into the clump of uncommented tests) when the dates become
-;;; very old.
-;;;
-;;; By convention, test-prefix strings have no whitespace.  This makes
-;;; change log entries more regular.
+(with-test-prefix "throw/catch"
 
-;;;; Code:
+  (with-test-prefix "wrong type argument"
 
-(use-modules (test-suite lib) (ice-9 regex) (ice-9 common-list))
+    (pass-if-exception "(throw 1)"
+      exception:wrong-type-arg
+      (throw 1)))
 
-(defmacro expect-exception (name-snippet expression)
-  `(pass-if (with-output-to-string
-              (lambda ()
-                (for-each display
-                          (list
-                           "`"
-                           (let ((x (symbol->string ',name-snippet)))
-                             (substring x 2 (string-length x)))
-                           "' expected: "))
-                (write ',expression)))
-            (catch #t
-                   (lambda () ,expression #f) ; conniving falsehood!
-                   (lambda args
-                     ;; squeeze value to `#t'
-                     (not (notany (lambda (x)
-                                    (and (string? x)
-                                         (string-match ,name-snippet x)))
-                                  args))))))
+  (with-test-prefix "wrong number of arguments"
 
-(define goad expect-exception)
+    (pass-if-exception "(throw)"
+      exception:wrong-num-args
+      (throw))
 
-;; Exception messages
-;; Ideally, we would mine these out of libguile/error.[hc], etc.
-;; (Someday, when guile is re-implemented in Scheme....)
+    (pass-if-exception "throw 1 / catch 0"
+      exception:wrong-num-args
+      (catch 'a
+	(lambda () (throw 'a))
+	(lambda () #f)))
 
-(define exception:bad-bindings
-  (cons 'misc-error "^bad bindings"))
-(define exception:bad-formals
-  (cons 'misc-error "^bad formals"))
-(define exception:bad-var
-  (cons 'misc-error "^bad variable"))
-(define exception:missing/extra-expr
-  (cons 'misc-error "^missing or extra expression"))
+    (pass-if-exception "throw 2 / catch 1"
+      exception:wrong-num-args
+      (catch 'a
+	(lambda () (throw 'a 2))
+	(lambda (x) #f)))
 
-(define x:unbound-var "[Uu]nbound variable")
-(define x:bad-var "[Bb]ad variable")
-(define x:bad-formals "[Bb]ad formals")
-(define x:bad-bindings "[Bb]ad bindings")
-(define x:bad-body "[Bb]ad body")
-(define x:bad/missing-clauses "[Bb]ad or missing clauses")
-(define x:missing/extra-expr "[Mm]issing or extra expression")
-(define x:wrong-num-args "[Ww]rong number of arguments")
-(define x:wrong-type-arg "[Ww]rong type argument")
+    (pass-if-exception "throw 1 / catch 2"
+      exception:wrong-num-args
+      (catch 'a
+	(lambda () (throw 'a))
+	(lambda (x y) #f)))
 
-;; This is to encourage people to write tests.
+    (pass-if-exception "throw 3 / catch 2"
+      exception:wrong-num-args
+      (catch 'a
+	(lambda () (throw 'a 2 3))
+	(lambda (y x) #f)))
 
-(define                   x:hm "[Hh]m")                   ;-D
- (define                 x:bad "[Bb]ad")                 ;-D
-  (define               x:sick "[Ss]ick")               ;-D
-   (define             x:wrong "[Ww]rong")             ;-D
-    (define           x:stupid "[Ss]tupid")           ;-D
-     (define         x:strange "[Ss]trange")         ;-D
-      (define       x:unlikely "[Uu]nlikely")       ;-D
-       (define     x:inelegant "[Ii]nelegant")     ;-D
-        (define   x:suboptimal "[Ss]uboptimal")   ;-D
-         (define x:bletcherous "[Bb]letcherous") ;-D   h a t - t h e - ?!?
-
-;; Tests
-
-(with-test-prefix "syntax"
-  (with-test-prefix "lambda"
-
-    (goad x:bad-formals (lambda (x 1) 2))
-    (goad x:bad-formals (lambda (1 x) 2))
-    (goad x:bad-formals (lambda (x "a") 2))
-    (goad x:bad-formals (lambda ("a" x) 2))
-
-    (expect-fail-exception "(lambda (x x) 1)"
-      exception:bad-formals
-      (lambda (x x) 1))
-
-    (expect-fail-exception "(lambda (x x x) 1)"
-      exception:bad-formals
-      (lambda (x x x) 1))
-
-    (with-test-prefix "cond-arrow-proc"
-      (goad x:bad-formals (cond (1 => (lambda (x 1) 2))))
-      ;; Add more (syntax lambda cond-arrow-proc) exceptions here.
-      )
-
-    ;; Add more (syntax lambda) exceptions here.
-    )
-  ;; Below, A1,B1 different from A2,B2 because A1,B1 are "named let".
-  (with-test-prefix "let"
-    (goad x:bad-body (let))
-    (goad x:bad-body (let 1))
-    (goad x:bad-body (let ()))
-    (goad x:bad-body (let (x)))
-    (goad x:bad-bindings (let (x) 1))
-    (goad x:bad-bindings (let ((x)) 3))
-    (goad x:bad-bindings (let ((x 1) y) x))
-    (goad x:bad-body (let x ()))        ; A1
-    (goad x:bad-body (let x (y)))       ; B1
-    ;; Add more (syntax let) exceptions here.
-    )
-  (with-test-prefix "let*"
-    (goad x:bad-body (let*))
-    (goad x:bad-body (let* 1))
-    (goad x:bad-body (let* ()))
-    (goad x:bad-body (let* (x)))
-    (goad x:bad-bindings (let* (x) 1))
-    (goad x:bad-bindings (let* ((x)) 3))
-    (goad x:bad-bindings (let* ((x 1) y) x))
-    (goad x:bad-bindings (let* x ()))   ; A2
-    (goad x:bad-bindings (let* x (y)))  ; B2
-    ;; Add more (syntax let*) exceptions here.
-    )
-  (with-test-prefix "letrec"
-    (goad x:bad-body (letrec))
-    (goad x:bad-body (letrec 1))
-    (goad x:bad-body (letrec ()))
-    (goad x:bad-body (letrec (x)))
-    (goad x:bad-bindings (letrec (x) 1))
-    (goad x:bad-bindings (letrec ((x)) 3))
-    (goad x:bad-bindings (letrec ((x 1) y) x))
-    (goad x:bad-bindings (letrec x ()))   ; A2
-    (goad x:bad-bindings (letrec x (y)))  ; B2
-    ;; Add more (syntax letrec) exceptions here.
-    )
-  (with-test-prefix "cond"
-    (goad x:bad/missing-clauses (cond))
-    (goad x:bad/missing-clauses (cond #t))
-    (goad x:bad/missing-clauses (cond 1))
-    (goad x:bad/missing-clauses (cond 1 2))
-    (goad x:bad/missing-clauses (cond 1 2 3))
-    (goad x:bad/missing-clauses (cond 1 2 3 4))
-    (goad x:bad/missing-clauses (cond ()))
-    (goad x:bad/missing-clauses (cond () 1))
-    (goad x:bad/missing-clauses (cond (1) 1))
-    ;; Add more (syntax cond) exceptions here.
-    )
-  (with-test-prefix "if"
-    (goad x:missing/extra-expr (if))
-    (goad x:missing/extra-expr (if 1 2 3 4))
-    ;; Add more (syntax if) exceptions here.
-    )
-  (with-test-prefix "define"
-    (goad x:missing/extra-expr (define))
-    ;; Add more (syntax define) exceptions here.
-    )
-  (with-test-prefix "set!"
-    (goad x:missing/extra-expr (set!))
-    (goad x:missing/extra-expr (set! 1))
-    (goad x:missing/extra-expr (set! 1 2 3))
-    ;; Add more (syntax set!) exceptions here.
-    )
-  (with-test-prefix "misc"
-    (goad x:missing/extra-expr (quote))
-
-    ;; R5RS says:
-    ;; *Note:* In many dialects of Lisp, the empty combination, (),
-    ;; is a legitimate expression.  In Scheme, combinations must
-    ;; have at least one subexpression, so () is not a syntactically
-    ;; valid expression.
-    (expect-fail-exception "empty parentheses \"()\""
-      exception:missing/extra-expr
-      ())
-
-    ;; Add more (syntax misc) exceptions here.
-    )
-  ;; Add more (syntax) exceptions here.
-  )
-
-(with-test-prefix "bindings"
-  (with-test-prefix "unbound"
-    (goad x:unbound-var unlikely-to-be-bound)
-    (goad x:unbound-var (unlikely-to-be-bound))
-    ;; Add more (bindings unbound) exceptions here.
-    )
-  (with-test-prefix "immutable-modification"
-    (goad x:bad-var (set! "some-string" #t))
-    (goad x:bad-var (set! 1 #t))
-    (goad x:bad-var (set! #t #f))
-    (goad x:bad-var (set! #f #t))
-    (goad x:bad-var (set! #\space 'the-final-frontier))
-    (goad x:wrong-type-arg (set! (symbol->string 'safe) 1))
-    (goad x:wrong-type-arg (set! '"abc" 1)) ; from r5rs
-    (goad x:bad-var (set! "abc" 1))
-    (goad x:wrong-type-arg (set! '145932 1))
-    (goad x:bad-var (set! 145932 1))
-    (goad x:wrong-type-arg (set! '#t 1))
-    (goad x:wrong-type-arg (set! '#f 1))
-
-    ;; Add more (bindings immutable-modification) exceptions here.
-    )
-  (with-test-prefix "let"
-    (goad x:bad-var (let ((1 2)) 3))
-    (goad x:unbound-var (let ((x 1) (y x)) y))
-
-    (expect-fail-exception "(let ((x 1) (x 2)) x)"
-      exception:bad-bindings
-      (let ((x 1) (x 2)) x))
-
-    ;; Add more (bindings let) exceptions here.
-    )
-  (with-test-prefix "let*"
-    (goad x:bad-var (let* ((1 2)) 3))
-
-    (expect-fail-exception "(let* ((x 1) (x 2)) x)"
-      exception:bad-bindings
-      (let* ((x 1) (x 2)) x))
-
-    ;; Add more (bindings let*) exceptions here.
-    )
-  (with-test-prefix "letrec"
-    (goad x:bad-var (letrec ((1 2)) 3))
-    (goad x:unbound-var (letrec ((x 1) (y x)) y))
-
-    (expect-fail-exception "(letrec ((x 1) (x 2)) x)"
-      exception:bad-bindings
-      (letrec ((x 1) (x 2)) x))
-
-    ;; Add more (bindings letrec) exceptions here.
-    )
-  ;; Add more (bindings) exceptions here.
-  )
-
-(with-test-prefix "application"
-  (goad x:wrong-num-args (let ((x (lambda (a b) (+ a b)))) (x 3)))
-  ;; Add more (application) exceptions here.
-  )
-
-;; Local variables:
-;; eval: (put 'with-test-prefix 'scheme-indent-function 1)
-;; End:
-
-;;; exceptions.test ends here
+    (pass-if-exception "throw 1 / catch 2+"
+      exception:wrong-num-args
+      (catch 'a
+	(lambda () (throw 'a))
+	(lambda (x y . rest) #f)))))
diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test
index 28b86b095..d6deef1db 100644
--- a/test-suite/tests/r4rs.test
+++ b/test-suite/tests/r4rs.test
@@ -1012,3 +1012,9 @@
 (test-sc4)
 (test-delay)
 "last item in file"
+
+
+;; FIXME:  We shouldn't create any global bindings in the test files or
+;; alternatively execute every test file's code in a module of its own
+(if (defined? 'x) (undefine x))
+(if (defined? 'y) (undefine y))
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
new file mode 100644
index 000000000..550f7fa82
--- /dev/null
+++ b/test-suite/tests/syntax.test
@@ -0,0 +1,397 @@
+;;;; syntax.test --- test suite for Guile's syntactic forms    -*- 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
+
+
+(define exception:bad-bindings
+  (cons 'misc-error "^bad bindings"))
+(define exception:bad-body
+  (cons 'misc-error "^bad body"))
+(define exception:bad-formals
+  (cons 'misc-error "^bad formals"))
+(define exception:bad-var
+  (cons 'misc-error "^bad variable"))
+(define exception:bad/missing-clauses
+  (cons 'misc-error "^bad or missing clauses"))
+(define exception:missing/extra-expr
+  (cons 'misc-error "^missing or extra expression"))
+
+
+(with-test-prefix "expressions"
+
+  (with-test-prefix "missing or extra expression"
+
+    ;; R5RS says:
+    ;; *Note:* In many dialects of Lisp, the empty combination, (),
+    ;; is a legitimate expression.  In Scheme, combinations must
+    ;; have at least one subexpression, so () is not a syntactically
+    ;; valid expression.
+    (expect-fail-exception "empty parentheses \"()\""
+      exception:missing/extra-expr
+      ())))
+
+(with-test-prefix "lambda"
+
+  (with-test-prefix "bad formals"
+
+    (pass-if-exception "(lambda (x 1) 2)" 
+      exception:bad-formals
+      (lambda (x 1) 2))
+
+    (pass-if-exception "(lambda (1 x) 2)"
+      exception:bad-formals
+      (lambda (1 x) 2))
+
+    (pass-if-exception "(lambda (x \"a\") 2)"
+      exception:bad-formals
+      (lambda (x "a") 2))
+
+    (pass-if-exception "(lambda (\"a\" x) 2)"
+      exception:bad-formals
+      (lambda ("a" x) 2))
+
+    (expect-fail-exception "(lambda (x x) 1)"
+      exception:bad-formals
+      (lambda (x x) 1))
+
+    (expect-fail-exception "(lambda (x x x) 1)"
+      exception:bad-formals
+      (lambda (x x x) 1))))
+
+(with-test-prefix "let"
+
+  (with-test-prefix "bindings"
+
+    (pass-if-exception "late binding"
+      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))))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let)"
+      exception:bad-body
+      (let))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let 1)"
+      exception:bad-body
+      (let 1))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let (x))"
+      exception:bad-body
+      (let (x))))
+
+  (with-test-prefix "bad bindings"
+
+    (pass-if-exception "(let (x) 1)"
+      exception:bad-bindings
+      (let (x) 1))
+
+    (pass-if-exception "(let ((x)) 3)"
+      exception:bad-bindings
+      (let ((x)) 3))
+
+    (pass-if-exception "(let ((x 1) y) x)"
+      exception:bad-bindings
+      (let ((x 1) y) x))
+
+    (pass-if-exception "(let ((1 2)) 3)"
+      exception:bad-var
+      (let ((1 2)) 3))
+
+    (expect-fail-exception "(let ((x 1) (x 2)) x)"
+      exception:bad-bindings
+      (let ((x 1) (x 2)) x))))
+
+(with-test-prefix "named let"
+
+  (with-test-prefix "bad body"
+
+    (pass-if-exception "(let x ())"
+      exception:bad-body
+      (let x ()))
+
+    (pass-if-exception "(let x ((y 1)))"
+      exception:bad-body
+      (let x ((y 1))))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let x (y))"
+      exception:bad-body
+      (let x (y)))))
+
+(with-test-prefix "let*"
+
+  (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))))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let*)"
+      exception:bad-body
+      (let*))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let* 1)"
+      exception:bad-body
+      (let* 1))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(let* (x))"
+      exception:bad-body
+      (let* (x))))
+
+  (with-test-prefix "bad bindings"
+
+    (pass-if-exception "(let* (x) 1)"
+      exception:bad-bindings
+      (let* (x) 1))
+
+    (pass-if-exception "(let* ((x)) 3)"
+      exception:bad-bindings
+      (let* ((x)) 3))
+
+    (pass-if-exception "(let* ((x 1) y) x)"
+      exception:bad-bindings
+      (let* ((x 1) y) x))
+
+    (pass-if-exception "(let* x ())"
+      exception:bad-bindings
+      (let* x ()))
+
+    (pass-if-exception "(let* x (y))"
+      exception:bad-bindings
+      (let* x (y)))
+
+    (pass-if-exception "(let* ((1 2)) 3)"
+      exception:bad-var
+      (let* ((1 2)) 3))
+
+    (expect-fail-exception "(let* ((x 1) (x 2)) x)"
+      exception:bad-bindings
+      (let* ((x 1) (x 2)) x))))
+
+(with-test-prefix "letrec"
+
+  (with-test-prefix "bindings"
+
+    (pass-if-exception "initial bindings are undefined"
+      exception:unbound-var
+      (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))))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(letrec)"
+      exception:bad-body
+      (letrec))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(letrec 1)"
+      exception:bad-body
+      (letrec 1))
+
+    ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
+    (pass-if-exception "(letrec (x))"
+      exception:bad-body
+      (letrec (x))))
+
+  (with-test-prefix "bad bindings"
+
+    (pass-if-exception "(letrec (x) 1)"
+      exception:bad-bindings
+      (letrec (x) 1))
+
+    (pass-if-exception "(letrec ((x)) 3)"
+      exception:bad-bindings
+      (letrec ((x)) 3))
+
+    (pass-if-exception "(letrec ((x 1) y) x)"
+      exception:bad-bindings
+      (letrec ((x 1) y) x))
+
+    (pass-if-exception "(letrec x ())"
+      exception:bad-bindings
+      (letrec x ()))
+
+    (pass-if-exception "(letrec x (y))"
+      exception:bad-bindings
+      (letrec x (y)))
+
+    (pass-if-exception "(letrec ((1 2)) 3)"
+      exception:bad-var
+      (letrec ((1 2)) 3))
+
+    (expect-fail-exception "(letrec ((x 1) (x 2)) x)"
+      exception:bad-bindings
+      (letrec ((x 1) (x 2)) x))))
+
+(with-test-prefix "if"
+
+  (with-test-prefix "missing or extra expressions"
+
+    (pass-if-exception "(if)"
+      exception:missing/extra-expr
+      (if))
+
+    (pass-if-exception "(if 1 2 3 4)"
+      exception:missing/extra-expr
+      (if 1 2 3 4))))
+
+(with-test-prefix "cond"
+
+  (with-test-prefix "bad or missing clauses"
+
+    (pass-if-exception "(cond)"
+      exception:bad/missing-clauses
+      (cond))
+
+    (pass-if-exception "(cond #t)"
+      exception:bad/missing-clauses
+      (cond #t))
+
+    (pass-if-exception "(cond 1)"
+      exception:bad/missing-clauses
+      (cond 1))
+
+    (pass-if-exception "(cond 1 2)"
+      exception:bad/missing-clauses
+      (cond 1 2))
+
+    (pass-if-exception "(cond 1 2 3)"
+      exception:bad/missing-clauses
+      (cond 1 2 3))
+
+    (pass-if-exception "(cond 1 2 3 4)"
+      exception:bad/missing-clauses
+      (cond 1 2 3 4))
+
+    (pass-if-exception "(cond ())"
+      exception:bad/missing-clauses
+      (cond ()))
+
+    (pass-if-exception "(cond () 1)"
+      exception:bad/missing-clauses
+      (cond () 1))
+
+    (pass-if-exception "(cond (1) 1)"
+      exception:bad/missing-clauses
+      (cond (1) 1))))
+
+(with-test-prefix "cond =>"
+
+  (with-test-prefix "bad formals"
+
+    (pass-if-exception "=> (lambda (x 1) 2)"
+      exception:bad-formals
+      (cond (1 => (lambda (x 1) 2))))))
+
+(with-test-prefix "define"
+
+  (with-test-prefix "missing or extra expressions"
+
+    (pass-if-exception "(define)"
+      exception:missing/extra-expr
+      (define))))
+
+(with-test-prefix "set!"
+
+  (with-test-prefix "missing or extra expressions"
+
+    (pass-if-exception "(set!)"
+      exception:missing/extra-expr
+      (set!))
+
+    (pass-if-exception "(set! 1)"
+      exception:missing/extra-expr
+      (set! 1))
+
+    (pass-if-exception "(set! 1 2 3)"
+      exception:missing/extra-expr
+      (set! 1 2 3)))
+
+  (with-test-prefix "bad variable"
+
+    (pass-if-exception "(set! \"\" #t)"
+      exception:bad-var
+      (set! "" #t))
+
+    (pass-if-exception "(set! 1 #t)"
+      exception:bad-var
+      (set! 1 #t))
+
+    (pass-if-exception "(set! #t #f)"
+      exception:bad-var
+      (set! #t #f))
+
+    (pass-if-exception "(set! #f #t)"
+      exception:bad-var
+      (set! #f #t))
+
+    (pass-if-exception "(set! #\space #f)"
+      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"
+
+    (pass-if-exception "(quote)"
+      exception:missing/extra-expr
+      (quote))
+
+    (pass-if-exception "(quote a b)"
+      exception:missing/extra-expr
+      (quote a b))))