** ASSOC now ignores NIL elements in an alist.
** CEILING now gives the right answer with MOST-NEGATIVE-FIXNUM
and (1+ MOST-POSITIVE-FIXNUM) answers.
+ ** The addition of a method with invalid qualifiers to a generic
+ function does not cause an error to be signalled immediately;
+ a warning is signalled, and the error is generated only on
+ calling the generic function.
planned incompatible changes in 0.8.x:
* (not done yet, but planned:) When the profiling interface settles
;;; considered as state transitions.
(defvar *lazy-dfun-compute-p* t)
(defvar *early-p* nil)
+(defvar *max-emf-precomputation-methods* 0)
(defun finalize-specializers (gf)
- (let ((all-finalized t))
- (dolist (method (generic-function-methods gf))
- (dolist (specializer (method-specializers method))
- (when (and (classp specializer)
- (not (class-finalized-p specializer)))
- (if (class-has-a-forward-referenced-superclass-p specializer)
- (setq all-finalized nil)
- (finalize-inheritance specializer)))))
- all-finalized))
+ (let ((methods (generic-function-methods gf)))
+ (when (< (length methods) *max-emf-precomputation-methods*)
+ (let ((all-finalized t))
+ (dolist (method methods all-finalized)
+ (dolist (specializer (method-specializers method))
+ (when (and (classp specializer)
+ (not (class-finalized-p specializer)))
+ (if (class-has-a-forward-referenced-superclass-p specializer)
+ (setq all-finalized nil)
+ (finalize-inheritance specializer)))))))))
(defun make-initial-dfun (gf)
(let ((initial-dfun
(setq remove-again-p nil))
(when remove-again-p
(remove-method generic-function method))))
+
+ ;; KLUDGE II: ANSI saith that it is not an error to add a
+ ;; method with invalid qualifiers to a generic function of the
+ ;; wrong kind; it's only an error at generic function
+ ;; invocation time; I dunno what the rationale was, and it
+ ;; sucks. Nevertheless, it's probably a programmer error, so
+ ;; let's warn anyway. -- CSR, 2003-08-20
+ (let ((mc (generic-function-method-combination generic-functioN)))
+ (cond
+ ((eq mc *standard-method-combination*)
+ (when (and qualifiers
+ (or (cdr qualifiers)
+ (not (memq (car qualifiers)
+ '(:around :before :after)))))
+ (warn "~@<Invalid qualifiers for standard method combination ~
+ in method ~S:~2I~_~S.~@:>"
+ method qualifiers)))
+ ((short-method-combination-p mc)
+ (let ((mc-name (method-combination-type mc)))
+ (when (or (null qualifiers)
+ (cdr qualifiers)
+ (and (neq (car qualifiers) :around)
+ (neq (car qualifiers) mc-name)))
+ (warn "~@<Invalid qualifiers for ~S method combination ~
+ in method ~S:~2I~_~S.~@:>"
+ mc-name method qualifiers))))))
+
(unless skip-dfun-update-p
(update-ctors 'add-method
:generic-function generic-function
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-# Check that compiling and loading the file $1 generates an error
-# at load time; also that just loading it directly (into the
-# interpreter) generates an error.
-expect_load_error ()
-{
- # Test compiling and loading.
- $SBCL <<EOF
- (compile-file "$1")
- ;;; But loading the file should fail.
- (multiple-value-bind (value0 value1) (ignore-errors (load *))
- (assert (null value0))
- (format t "VALUE1=~S (~A)~%" value1 value1)
- (assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
-EOF
- if [ $? != 52 ]; then
- echo compile-and-load $1 test failed: $?
- exit 1
- fi
-
- # Test loading into the interpreter.
- $SBCL <<EOF
- (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
- (assert (null value0))
- (format t "VALUE1=~S (~A)~%" value1 value1)
- (assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
-EOF
- if [ $? != 52 ]; then
- echo load-into-interpreter $1 test failed: $?
- exit 1
- fi
-}
-
-# Test that a file compiles cleanly, with no ERRORs, WARNINGs or
-# STYLE-WARNINGs.
-#
-# Maybe this wants to be in a compiler.test.sh script? This function
-# was originally written to test APD's patch for slot readers and
-# writers not being known to the compiler. -- CSR, 2002-08-14
-expect_clean_compile ()
-{
- $SBCL <<EOF
- (multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
- (declare (ignore pathname))
- (assert (not warnings-p))
- (assert (not failure-p))
- (sb-ext:quit :unix-status 52))
-EOF
- if [ $? != 52 ]; then
- echo clean-compile $1 test failed: $?
- exit 1
- fi
-}
+. expect.sh
base_tmpfilename="clos-test-$$-tmp"
tmpfilename="$base_tmpfilename.lisp"
;; This definition has too many qualifiers, so loading the
;; DEFMETHOD should fail.
(defmethod zut progn :around ((x integer)) (print "integer"))
+ (zut 1)
EOF
expect_load_error $tmpfilename
;; This definition is missing the PROGN qualifier, and so the
;; DEFMETHOD should fail.
(defmethod zut ((x integer)) (print "integer"))
+ (zut 1)
EOF
expect_load_error $tmpfilename
;; This definition has too many qualifiers, so loading the
;; DEFMETHOD should fail.
(defmethod zut progn :around ((x integer)) (print "integer"))
+ (zut 1)
EOF
expect_load_error $tmpfilename
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-# FIXME: the functions below should be in their own file, sourced by
-# each of the *.test.sh scripts.
-
-# Check that compiling and loading the file $1 generates an error
-# at load time; also that just loading it directly (into the
-# interpreter) generates an error.
-expect_load_error ()
-{
- # Test compiling and loading.
- $SBCL <<EOF
- (compile-file "$1")
- ;;; But loading the file should fail.
- (multiple-value-bind (value0 value1) (ignore-errors (load *))
- (assert (null value0))
- (format t "VALUE1=~S (~A)~%" value1 value1)
- (assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
-EOF
- if [ $? != 52 ]; then
- echo compile-and-load $1 test failed: $?
- exit 1
- fi
-
- # Test loading into the interpreter.
- $SBCL <<EOF
- (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
- (assert (null value0))
- (format t "VALUE1=~S (~A)~%" value1 value1)
- (assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
-EOF
- if [ $? != 52 ]; then
- echo load-into-interpreter $1 test failed: $?
- exit 1
- fi
-}
-
-# Test that a file compiles cleanly, with no ERRORs, WARNINGs or
-# STYLE-WARNINGs.
-expect_clean_compile ()
-{
- $SBCL <<EOF
- (multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
- (declare (ignore pathname))
- (assert (not warnings-p))
- (assert (not failure-p))
- (sb-ext:quit :unix-status 52))
-EOF
- if [ $? != 52 ]; then
- echo clean-compile $1 test failed: $?
- exit 1
- fi
-}
-
-expect_warned_compile ()
-{
- $SBCL <<EOF
- (multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
- (declare (ignore pathname))
- (assert warnings-p)
- (assert (not failure-p))
- (sb-ext:quit :unix-status 52))
-EOF
- if [ $? != 52 ]; then
- echo warn-compile $1 test failed: $?
- exit 1
- fi
-}
-
-expect_failed_compile ()
-{
- $SBCL <<EOF
- (multiple-value-bind (pathname warnings-p failure-p)
- (compile-file "$1")
- (declare (ignore pathname warnings-p))
- (assert failure-p)
- (sb-ext:quit :unix-status 52))
-EOF
- if [ $? != 52 ]; then
- echo fail-compile $1 test failed: $?
- exit 1
- fi
-}
-
-fail_on_compiler_note ()
-{
- $SBCL <<EOF
- (handler-bind ((sb-ext:compiler-note #'error))
- (compile-file "$1")
- (sb-ext:quit :unix-status 52))
-EOF
- if [ $? != 52]; then
- echo compiler-note $1 test failed: $?
- exit 1
- fi
-}
+. expect.sh
base_tmpfilename="compiler-test-$$-tmp"
tmpfilename="$base_tmpfilename.lisp"
--- /dev/null
+# file to be sourced by scripts wanting to test the compiler
+
+# Check that compiling and loading the file $1 generates an error
+# at load time; also that just loading it directly (into the
+# interpreter) generates an error.
+expect_load_error ()
+{
+ # Test compiling and loading.
+ $SBCL <<EOF
+ (compile-file "$1")
+ ;;; But loading the file should fail.
+ (multiple-value-bind (value0 value1) (ignore-errors (load *))
+ (assert (null value0))
+ (format t "VALUE1=~S (~A)~%" value1 value1)
+ (assert (typep value1 'error)))
+ (sb-ext:quit :unix-status 52)
+EOF
+ if [ $? != 52 ]; then
+ echo compile-and-load $1 test failed: $?
+ exit 1
+ fi
+
+ # Test loading into the interpreter.
+ $SBCL <<EOF
+ (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
+ (assert (null value0))
+ (format t "VALUE1=~S (~A)~%" value1 value1)
+ (assert (typep value1 'error)))
+ (sb-ext:quit :unix-status 52)
+EOF
+ if [ $? != 52 ]; then
+ echo load-into-interpreter $1 test failed: $?
+ exit 1
+ fi
+}
+
+# Test that a file compiles cleanly, with no ERRORs, WARNINGs or
+# STYLE-WARNINGs.
+#
+# Maybe this wants to be in a compiler.test.sh script? This function
+# was originally written to test APD's patch for slot readers and
+# writers not being known to the compiler. -- CSR, 2002-08-14
+expect_clean_compile ()
+{
+ $SBCL <<EOF
+ (multiple-value-bind (pathname warnings-p failure-p)
+ (compile-file "$1")
+ (declare (ignore pathname))
+ (assert (not warnings-p))
+ (assert (not failure-p))
+ (sb-ext:quit :unix-status 52))
+EOF
+ if [ $? != 52 ]; then
+ echo clean-compile $1 test failed: $?
+ exit 1
+ fi
+}
+
+expect_warned_compile ()
+{
+ $SBCL <<EOF
+ (multiple-value-bind (pathname warnings-p failure-p)
+ (compile-file "$1")
+ (declare (ignore pathname))
+ (assert warnings-p)
+ (assert (not failure-p))
+ (sb-ext:quit :unix-status 52))
+EOF
+ if [ $? != 52 ]; then
+ echo warn-compile $1 test failed: $?
+ exit 1
+ fi
+}
+
+expect_failed_compile ()
+{
+ $SBCL <<EOF
+ (multiple-value-bind (pathname warnings-p failure-p)
+ (compile-file "$1")
+ (declare (ignore pathname warnings-p))
+ (assert failure-p)
+ (sb-ext:quit :unix-status 52))
+EOF
+ if [ $? != 52 ]; then
+ echo fail-compile $1 test failed: $?
+ exit 1
+ fi
+}
+
+fail_on_compiler_note ()
+{
+ $SBCL <<EOF
+ (handler-bind ((sb-ext:compiler-note #'error))
+ (compile-file "$1")
+ (sb-ext:quit :unix-status 52))
+EOF
+ if [ $? != 52]; then
+ echo compiler-note $1 test failed: $?
+ exit 1
+ fi
+}
+
(sleep 5))
(terminate-thread child))
+;; better would be "wait until all child threads have exited"
+(sleep 3)
+
(sb-ext:quit :unix-status 104)
;;; 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".)
-"0.8.2.51"
+"0.8.2.52"
projects / sbcl.git / commitdiff