primary methods with no specializers;
** the MOP generic function GENERIC-FUNCTION-DECLARATIONS is now
implemented;
- * fixed some bugs, shown by Paul Dietz' test suite:
- ** DOLIST puts its body in TAGBODY
- ** SET-EXCLUSIVE-OR sends arguments to :TEST function in the
- correct order
- ** MULTIPLE-VALUE-SETQ evaluates side-effectful places before
- value producing form
- ** if more variables are given to PROGV than values, extra
- variables are bound and made to have no value
- * fixed bug 166: compiler preserves "there is a way to go"
- invariant when deleting code
+ ** the Readers for Class Metaobjects methods CLASS-DIRECT-SLOTS
+ and CLASS-DIRECT-DEFAULT-INITARGS have been implemented for
+ FORWARD-REFERENCED-CLASSes; error reporting on
+ CLASS-DEFAULT-INITARGS, CLASS-PRECEDENCE-LIST and CLASS-SLOTS
+ has been improved;
+ * fixed some bugs, shown by Paul Dietz' test suite:
+ ** DOLIST puts its body in TAGBODY
+ ** SET-EXCLUSIVE-OR sends arguments to :TEST function in the
+ correct order
+ ** MULTIPLE-VALUE-SETQ evaluates side-effectful places before
+ value producing form
+ ** if more variables are given to PROGV than values, extra
+ variables are bound and made to have no value
+ ** NSUBSTITUTE on list arguments gets the right answer with
+ :FROM-END
+ ** ELT signals an error of type TYPE-ERROR when the index argument
+ is not a valid sequence index;
+ * fixed bug 166: compiler preserves "there is a way to go"
+ invariant when deleting code.
+ * fixed bug 172: macro lambda lists with required arguments after
+ &REST arguments now cause an error to be signalled. (thanks to
+ Matthew Danish)
planned incompatible changes in 0.7.x:
* When the profiling interface settles down, maybe in 0.7.x, maybe
(declare (fixnum index dim))
(unless (< -1 index dim)
(if invalid-index-error-p
- (error "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S"
- index axis array)
+ (error 'simple-type-error
+ :format-control "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S"
+ :format-arguments (list index axis array)
+ :datum index
+ :expected-type `(integer 0 (,dim)))
(return-from %array-row-major-index nil)))
(incf result (* chunk-size index))
(setf chunk-size (* chunk-size dim))))
- (let ((index (first subscripts)))
- (unless (< -1 index (length (the (simple-array * (*)) array)))
+ (let ((index (first subscripts))
+ (length (length (the (simple-array * (*)) array))))
+ (unless (< -1 index length)
(if invalid-index-error-p
- (error "invalid index ~W in ~S" index array)
+ ;; FIXME: perhaps this should share a format-string
+ ;; with INVALID-ARRAY-INDEX-ERROR or
+ ;; INDEX-TOO-LARGE-ERROR?
+ (error 'simple-type-error
+ :format-control "invalid index ~W in ~S"
+ :format-arguments (list index array)
+ :datum index
+ :expected-type `(integer 0 (,length)))
(return-from %array-row-major-index nil)))
index))))
;;; Out-of-range &KEY END arguments are similar to, but off by one
;;; from out-of-range indices into the sequence.
-(define-condition index-too-large-error (type-error)
+;;;
+;;; FIXME: Uh, but it isn't used for &KEY END things -- in fact, this
+;;; is only used in one place, in SUBSEQ. Is it really necessary? Is
+;;; it here so that we can actually go round seq.lisp decorating all
+;;; the sequence functions with extra checks? -- CSR, 2002-11-01
+(define-condition end-too-large-error (type-error)
()
(:report
(lambda (condition stream)
:format-arguments (list key-name)))
(deferr invalid-array-index-error (array bound index)
- (error 'simple-error
+ (error 'simple-type-error
:format-control
"invalid array index ~W for ~S (should be nonnegative and <~W)"
- :format-arguments (list index array bound)))
+ :format-arguments (list index array bound)
+ :datum index
+ :expected-type `(integer 0 (,bound))))
(deferr object-not-simple-array-error (object)
(error 'type-error
(if (null end)
(setf end (length sequence))
(unless (<= end (length sequence))
- (signal-index-too-large-error sequence end)))
+ (signal-end-too-large-error sequence end)))
(do ((old-index start (1+ old-index))
(new-index 0 (1+ new-index))
(copy (make-sequence-like sequence (- end start))))
(or (eq s *the-class-t*)
(eq s *the-class-stream*)))
\f
+;;; Some necessary methods for FORWARD-REFERENCED-CLASS
+(defmethod class-direct-slots ((class forward-referenced-class)) ())
+(defmethod class-direct-default-initargs ((class forward-referenced-class)) ())
+(macrolet ((def (method)
+ `(defmethod ,method ((class forward-referenced-class))
+ (error "~@<~I~S was called on a forward referenced class:~2I~_~S~:>"
+ ',method class))))
+ (def class-default-initargs)
+ (def class-precedence-list)
+ (def class-slots))
+
(defmethod validate-superclass ((c slot-class)
(f forward-referenced-class))
t)
(in-package "MOP-TEST")
\f
+;;; Readers for Class Metaobjects (pp. 212--214 of AMOP)
+(defclass red-herring (forward-ref) ())
+
+(assert (null (sb-pcl:class-direct-slots (sb-pcl:find-class 'forward-ref))))
+(assert (null (sb-pcl:class-direct-default-initargs
+ (sb-pcl:find-class 'forward-ref))))
+\f
;;; Readers for Generic Function Metaobjects (pp. 216--218 of AMOP)
(defgeneric fn-with-odd-arg-precedence (a b c)
(:argument-precedence-order b c a))
;; the analogous type checking for MAP/%MAP.
))
\f
+;;; ELT should signal an error of type TYPE-ERROR if its index
+;;; argument isn't a valid sequence index for sequence:
+(defun test-elt-signal (x)
+ (elt x 3))
+(multiple-value-bind (result error)
+ (ignore-errors (test-elt-signal "foo"))
+ (assert (null result))
+ (assert (typep error 'type-error)))
+(assert (eql (test-elt-signal "foob") #\b))
+\f
;;; success
(quit :unix-status 104)
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.9.28"
+"0.7.9.29"
projects / sbcl.git / commitdiff