0.7.12.42:

	A couple of minor fixes for bugs caught by Paul Dietz' test
	suite.
	... adjust source transform for CONSTANTLY to return a
		side-effect-free function;
	... OTHERWISE only introduces an otherwise-clause in TYPECASE if
		it's the last clause;
	... while I'm frobbing TYPECASE, make the style-warning format
		string such that output is pretty.
	... NEWS update

diff --git a/NEWS b/NEWS
index f3a9e43..98a1fa2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1568,6 +1568,13 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12:
     ** the type system is now cleverer about negations of numeric
        types, and consequently understands the BIGNUM and RATIO types
        better;
+    ** the type system is now cleverer about the interaction between
+       INTEGER and RATIO types: while bugs still remain, many more
+       cases are accurately computed;
+    ** in TYPECASE, OTHERWISE now only introduces an otherwise-clause
+       if it is in the last clause;
+    ** CONSTANTLY now correctly returns a side-effect-free function in
+       all cases;
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index b4453d1..f14e8e2 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -197,16 +197,19 @@
   (let ((keyform-value (gensym))
        (clauses ())
        (keys ()))
-    (dolist (case cases)
+    (do* ((cases cases (cdr cases))
+         (case (car cases) (car cases)))
+        ((null cases) nil)
       (unless (list-of-length-at-least-p case 1)
        (error "~S -- bad clause in ~S" case name))
       (destructuring-bind (keyoid &rest forms) case
-       (cond ((memq keyoid '(t otherwise))
+       (cond ((and (memq keyoid '(t otherwise))
+                   (null (cdr cases)))
               (if errorp
                   (progn
-                    ;; FIXME: this message could probably do with
-                    ;; some loving pretty-printer format controls.
-                    (style-warn "Treating bare ~A in ~A as introducing a normal-clause, not an otherwise-clause" keyoid name)
+                    (style-warn "~@<Treating bare ~A in ~A as introducing a ~
+                                  normal-clause, not an otherwise-clause~@:>"
+                                keyoid name)
                     (push keyoid keys)
                     (push `((,test ,keyform-value ',keyoid) nil ,@forms)
                           clauses))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 0661685..d7b8385 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -29,12 +29,14 @@
 (define-source-transform identity (x) `(prog1 ,x))
 (define-source-transform values (x) `(prog1 ,x))
 
-;;; Bind the values and make a closure that returns them.
+;;; Bind the value and make a closure that returns them.
 (define-source-transform constantly (value)
-  (let ((rest (gensym "CONSTANTLY-REST-")))
-    `(lambda (&rest ,rest)
-       (declare (ignore ,rest))
-       ,value)))
+  (let ((rest (gensym "CONSTANTLY-REST-"))
+       (n-value (gensym "CONSTANTLY-VALUE-")))
+    `(let ((,n-value ,value))
+      (lambda (&rest ,rest)
+       (declare (ignore ,rest))
+       ,n-value))))
 
 ;;; If the function has a known number of arguments, then return a
 ;;; lambda with the appropriate fixed number of args. If the

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 0d4c271..130a5af 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -311,3 +311,13 @@
                        (push node path))
                   (when (funcall equalp key (node-key node))
                     (return (values node path t))))))))
+
+;;; CONSTANTLY should return a side-effect-free function (bug caught
+;;; by Paul Dietz' test suite)
+(let ((i 0))
+  (let ((fn (constantly (progn (incf i) 1))))
+    (assert (= i 1))
+    (assert (= (funcall fn) 1))
+    (assert (= i 1))
+    (assert (= (funcall fn) 1))
+    (assert (= i 1))))

diff --git a/version.lisp-expr b/version.lisp-expr
index c9edda2..01a8835 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.12.41"
+"0.7.12.42"