From: William Harold Newman <william.newman@airmail.net>
Date: Tue, 28 May 2002 22:06:57 +0000 (+0000)
Subject: 0.7.4.4:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=063e696d6151fd6329677216646e872731e6a85d;p=sbcl.git

0.7.4.4:
	fix for dumb bug, where excessive optimization of DEFSTRUCT
		predicate functions prevented arg count checking
---

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 4d6f1cb..ddce36a 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -213,11 +213,12 @@
 	    ((structure funcallable-structure)
 	     (/show0 "with-LAYOUT case")
 	     (lambda (object)
-	       (declare (optimize (speed 3) (safety 0)))
-	       (/noshow0 "in with-LAYOUT structure predicate closure, OBJECT,LAYOUT=..")
-	       (/nohexstr object)
-	       (/nohexstr layout)
-	       (typep-to-layout object layout)))
+	       (locally ; <- to keep SAFETY 0 from affecting arg count checking
+		 (declare (optimize (speed 3) (safety 0)))
+		 (/noshow0 "in with-LAYOUT structure predicate closure, OBJECT,LAYOUT=..")
+		 (/nohexstr object)
+		 (/nohexstr layout)
+		 (typep-to-layout object layout))))
 	    ;; structures with no LAYOUT (i.e. :TYPE VECTOR or :TYPE LIST)
 	    ;;
 	    ;; FIXME: should handle the :NAMED T case in these cases
diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index 14724d7..bca97ca 100644
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -353,6 +353,14 @@
   (assert (eql (manyraw-dd copy) #c(0.33 0.33)))
   (assert (eql (manyraw-ee copy) #c(0.44d0 0.44d0))))
 
+;;;; miscellaneous old bugs
+
+(defstruct ya-struct)
+(when (ignore-errors (or (ya-struct-p) 12))
+  (error "YA-STRUCT-P of no arguments should signal an error."))
+(when (ignore-errors (or (ya-struct-p 'too 'many 'arguments) 12))
+  (error "YA-STRUCT-P of three arguments should signal an error."))
+
 ;;; success
 (format t "~&/returning success~%")
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 8ea0678..ebfa34e 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.4.3"
+"0.7.4.4"