1.0.4.77: oops, forgot to cvs add a new file in .76

diff --git a/tests/case.pure.lisp b/tests/case.pure.lisp
new file mode 100644 (file)
index 0000000..a7898e6
--- /dev/null
+++ b/tests/case.pure.lisp
@@ -0,0 +1,53 @@
+;;;; tests of the CASE family of macros without side effects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(cl:in-package :cl-user)
+
+(loop
+  for (expected kind . clauses) in
+    '((nil
+       case (1 1)
+            (2 2)
+            (3 3))
+      ("Duplicate key 1 in CASE form, occurring in the first clause:  (1 1), and the second clause:  (1 2)"
+       case (1 1)
+            (1 2))
+      ("Duplicate key 2 in CASE form, occurring in the first clause:  ((1 2) 1), and the second clause:  ((2 3) 2)"
+       case ((1 2) 1)
+            ((2 3) 2))
+      (nil
+       case (#1=(1) 1)
+            ((#1#) 2)))
+  for form = `(lambda ()
+                (,kind *readtable*
+                  ,@clauses))
+  do
+    (multiple-value-bind (fun warnings-p failure-p)
+        (handler-bind ((style-warning (lambda (c)
+                        (if expected
+                          (assert (search expected
+                                          (with-standard-io-syntax
+                                            (let ((*print-right-margin* nil)
+                                                  (*print-pretty* t))
+                                              (remove #\Newline (princ-to-string c)))))
+                                  ()
+                                  "~S should have warned ~S, but instead warned: ~A" form expected c)
+                          (error "~S shouldn't give a warning, but did: ~A" form c))
+                        (setf expected nil))))
+          (compile nil form))
+      (assert (functionp fun))
+      (assert (null expected)
+              ()
+              "~S should have warned ~S, but didn't."
+              form expected)
+      (assert (not failure-p))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 847e76e..94d18a4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.4.76"
+"1.0.4.77"