47:
DEFCLASS bugs reported by Peter Van Eynde July 25, 2000:
- a: (DEFCLASS FOO () (A B A)) should signal a PROGRAM-ERROR, and
- doesn't.
- b: (DEFCLASS FOO () (A B A) (:DEFAULT-INITARGS X A X B)) should
- signal a PROGRAM-ERROR, and doesn't.
- c: (DEFCLASS FOO07 NIL ((A :ALLOCATION :CLASS :ALLOCATION :CLASS))),
- and other DEFCLASS forms with duplicate specifications in their
- slots, should signal a PROGRAM-ERROR, and doesn't.
d: (DEFGENERIC IF (X)) should signal a PROGRAM-ERROR, but instead
causes a COMPILER-ERROR.
Since this is a reasonable user error, it shouldn't be reported as
an SBCL bug.
-171:
- (reported by Pierre Mai while investigating bug 47):
- (DEFCLASS FOO () ((A :SILLY T)))
- signals a SIMPLE-ERROR, not a PROGRAM-ERROR.
-
172:
sbcl's treatment of at least macro lambda lists is too permissive;
e.g., in sbcl-0.7.3.7:
* fixed several bugs in compiler checking of type declarations, i.e.
violations of the Python "declarations are assertions" principle
(thanks to Alexey Dejneka)
+ * fixed several bugs in PCL's error checking (thanks to Gerd
+ Moellmann)
planned incompatible changes in 0.7.x:
* When the profiling interface settles down, maybe in 0.7.x, maybe
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 15
- (multiple-value-bind (word extra) (floor index ,elements-per-word)
+ (multiple-value-bind (word extra)
+ (floor index ,elements-per-word)
(setf extra (logxor extra (1- ,elements-per-word)))
(let ((offset (- (* (+ word vector-data-offset) n-word-bytes)
other-pointer-lowtag)))
(inst li temp offset)
(inst ld result object temp))))
(unless (zerop extra)
- (inst srl result
- (logxor (* extra ,bits) ,(1- elements-per-word))))
+ (inst srl result (* extra ,bits)))
(unless (= extra ,(1- elements-per-word))
(inst and result ,(1- (ash 1 bits)))))))
(define-vop (,(symbolicate 'data-vector-set/ type))
(nil nil (class class) t)))
) ; EVAL-WHEN
-(defmacro make-checking-or-caching-function-list ()
- `(list ,@(mapcar (lambda (key)
- `(cons ',key (emit-checking-or-caching-macro ,@key)))
- *checking-or-caching-list*)))
-
;;; Rather than compiling the constructors here, just tickle the range
;;; of shapes defined above, leaving the generation of the
;;; constructors to precompile-dfun-constructors.
(let* ((info (initialize-info class initargs))
(valid-p (initialize-info-valid-p info)))
(when (and (consp valid-p) (eq (car valid-p) :invalid))
- (error "Invalid initialization argument ~S for class ~S"
- (cdr valid-p) (class-name class))))
+ (error 'simple-program-error
+ :format-control "Invalid initialization argument ~S for class ~S"
+ :format-arguments (list (cdr valid-p) (class-name class)))))
(let ((instance (apply #'allocate-instance class initargs)))
(apply #'initialize-instance instance initargs)
instance))
(info (initialize-info class initargs))
(valid-p (initialize-info-ri-valid-p info)))
(when (and (consp valid-p) (eq (car valid-p) :invalid))
- (error "Invalid initialization argument ~S for class ~S"
- (cdr valid-p) (class-name class))))
+ (error 'simple-program-error
+ :format-control "Invalid initialization argument ~S for class ~S"
+ :format-arguments (list (cdr valid-p) (class-name class)))))
(apply #'shared-initialize instance nil initargs)
instance)
(doplist (key val) initargs
(unless (memq key legal)
(if error-p
- (error "Invalid initialization argument ~S for class ~S"
- key
- (class-name class))
+ (error 'simple-program-error
+ :format-control "Invalid initialization argument ~S for class ~S"
+ :format-arguments (list key (class-name class)))
(return-from check-initargs-2-plist nil)))))
t)
(dolist (key initkeys)
(unless (memq key legal)
(if error-p
- (error "Invalid initialization argument ~S for class ~S"
- key
- (class-name class))
+ (error 'simple-program-error
+ :format-control "Invalid initialization argument ~S for class ~S"
+ :format-arguments (list key (class-name class)))
(return-from check-initargs-2-list nil)))))
t)
*the-class-standard-class*)
(t
(class-of class)))))
+ ;; KLUDGE: It seemed to me initially that there ought to be a way
+ ;; of collecting all the erroneous problems in one go, rather than
+ ;; this way of solving the problem of signalling the errors that
+ ;; we are required to, which stops at the first bogus input.
+ ;; However, after playing around a little, I couldn't find that
+ ;; way, so I've left it as is, but if someone does come up with a
+ ;; better way... -- CSR, 2002-09-08
+ (loop for (slot . more) on (getf initargs :direct-slots)
+ for slot-name = (getf slot :name)
+ if (some (lambda (s) (eq slot-name (getf s :name))) more)
+ ;; FIXME: It's quite possible that we ought to define an
+ ;; SB-INT:PROGRAM-ERROR function to signal these and other
+ ;; errors throughout the code base that are required to be
+ ;; of type PROGRAM-ERROR.
+ do (error 'simple-program-error
+ :format-control "More than one direct slot with name ~S."
+ :format-arguments (list slot-name))
+ else
+ do (loop for (option value . more) on slot by #'cddr
+ when (and (member option
+ '(:allocation :type
+ :initform :documentation))
+ (not (eq unsupplied
+ (getf more option unsupplied))))
+ do (error 'simple-program-error
+ :format-control "Duplicate slot option ~S for slot ~S."
+ :format-arguments (list option slot-name))))
+ (loop for (initarg . more) on (getf initargs :direct-default-initargs)
+ for name = (car initarg)
+ when (some (lambda (a) (eq (car a) name)) more)
+ do (error 'simple-program-error
+ :format-control "Duplicate initialization argument ~
+ name ~S in :default-initargs of class ~A."
+ :format-arguments (list name class)))
(loop (unless (remf initargs :metaclass) (return)))
(loop (unless (remf initargs :direct-superclasses) (return)))
(loop (unless (remf initargs :direct-slots) (return)))
(aref x 12))))))
(error "error not thrown in COMPILED-DECLARED-AREF ~S" form))))))
+;;; On the SPARC, until sbcl-0.7.7.20, there was a bug in array references
+;;; for small vector elements (spotted by Raymond Toy).
+(assert (= (funcall
+ (lambda (rmdr)
+ (declare (type (simple-array bit (*)) rmdr)
+ (optimize (speed 3) (safety 0)))
+ (aref rmdr 0))
+ #*00000000000000000000000000000001000000000)
+ 0))
(defmethod gf (obj)
obj)
\f
+;;; Until sbcl-0.7.7.20, some conditions weren't being signalled, and
+;;; some others were of the wrong type:
+(macrolet ((assert-program-error (form)
+ `(multiple-value-bind (value error)
+ (ignore-errors ,form)
+ (assert (null value))
+ (assert (typep error 'program-error)))))
+ (assert-program-error (defclass foo001 () (a b a)))
+ (assert-program-error (defclass foo002 ()
+ (a b)
+ (:default-initargs x 'a x 'b)))
+ (assert-program-error (defclass foo003 ()
+ ((a :allocation :class :allocation :class))))
+ (assert-program-error (defclass foo004 ()
+ ((a :silly t)))))
+\f
;;;; success
(sb-ext:quit :unix-status 104)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.7.19"
+"0.7.7.20"
projects / sbcl.git / commitdiff