"*SETF-FDEFINITION-HOOK*"
;; error-reporting facilities
- "MAKE-CONDITION-LOAD-FORM"
- "COMPILED-PROGRAM-ERROR"
- "ENCAPSULATED-CONDITION"
- "MAKE-LOAD-FORM-ERROR"
+ "ENCAPSULATED-CONDITION" "COMPILED-PROGRAM-ERROR"
"SIMPLE-CONTROL-ERROR" "SIMPLE-FILE-ERROR"
"SIMPLE-PARSE-ERROR"
"SIMPLE-PROGRAM-ERROR" "SIMPLE-STREAM-ERROR"
(condition-actual-initargs condition)
(condition-assigned-slots condition))))
\f
-;;;; MAKE-LOAD-FORM equivalent for conditions.
-
-;;; We need this to be able to dump arbitrary encapsulated conditions
-;;; with MAKE-LOAD-FORM for COMPILED-PROGRAM-ERRORs. Unfortunately
-;;; ANSI specifies that MAKE-LOAD-FORM for conditions should signal an
-;;; error, despite the fact that it also specifies that the
-;;; file-compiler should use MAKE-LOAD-FORM for conditions. Bah.
-;;; Badness results if this is called before PCL is in place. Unlike
-;;; real make-load-form we return just a single form, so that it can
-;;; easily be embedded in the surrounding condition.
-(defun make-condition-load-form (condition &optional env)
- (with-unique-names (instance)
- (multiple-value-bind (create init)
- (make-load-form-saving-slots condition :environment env)
- (let ((fixed-init (subst instance condition init)))
- `(let ((,instance ,create))
- ,fixed-init
- ,instance)))))
-\f
;;;; various CONDITIONs specified by ANSI
(define-condition serious-condition (condition) ())
(case-failure-name condition)
(case-failure-possibilities condition)))))
-(define-condition compiled-program-error (encapsulated-condition program-error)
- ((source :initarg :source :reader program-error-source))
+(define-condition compiled-program-error (program-error)
+ ((message :initarg :message :reader program-error-message)
+ (source :initarg :source :reader program-error-source))
(:report (lambda (condition stream)
- (let ((source (program-error-source condition)))
- ;; Source may be either a list or string, and
- ;; string needs to be printed without escapes.
- (format stream "Execution of a form compiled with errors.~%~
- Form:~% ~
- ~:[~S~;~A~]~%~
- Compile-time-error:~% "
- (stringp source) source)
- (print-object (encapsulated-condition condition) stream)))))
-
-(def!method make-load-form ((condition compiled-program-error) &optional env)
- (let ((source (program-error-source condition)))
- ;; Safe since the encapsulated condition shouldn't contain
- ;; references back up to the main condition. The source needs to
- ;; be converted to a string, since it may contain arbitrary
- ;; unexternalizable objects.
- `(make-condition 'compiled-program-error
- :condition ,(make-condition-load-form
- (encapsulated-condition condition) env)
- :source ,(if (stringp source)
- source
- (write-to-string
- source :pretty t :circle t :escape t :readably nil)))))
-
-(define-condition make-load-form-error (encapsulated-condition error)
- ((object :initarg :object :reader make-load-form-error-object))
- (:report (lambda (condition stream)
- (let ((object (make-load-form-error-object condition)))
- ;; If the MAKE-LOAD-FORM-ERROR itself has been
- ;; externalized, the object will only have it's string
- ;; representation.
- (format stream "~@<Unable to externalize ~:[~S~;~A~], ~
- error from ~S:~:@>~% "
- (stringp object)
- object
- 'make-load-form)
- (print-object (encapsulated-condition condition) stream)))))
-
-(def!method make-load-form ((condition make-load-form-error) &optional env)
- (let ((object (make-load-form-error-object condition)))
- ;; Safe, because neither the object nor the encapsulated condition
- ;; should contain any references to the error itself. However, the
- ;; object will need to be converted to its string representation,
- ;; since the chances are that it's not externalizable.
- `(make-condition 'make-load-form-error
- :condition ,(make-condition-load-form
- (encapsulated-condition condition) env)
- :object ,(if (stringp object)
- object
- (write-to-string
- object :pretty t :circle t :escape t :readably nil)))))
+ (format stream "Execution of a form compiled with errors.~%~
+ Form:~% ~A~%~
+ Compile-time-error:~% ~A"
+ (program-error-source condition)
+ (program-error-message condition)))))
(define-condition simple-control-error (simple-condition control-error) ())
(define-condition simple-file-error (simple-condition file-error) ())
(values))
(defun make-compiler-error-form (condition source)
- ;; The condition must be literal so the this form kicks off the
- ;; MAKE-LOAD-FORM in the file-compiler for COMPILED-PROGRAM-ERROR,
- ;; not the encapsulated condition.
- `(error ,(make-condition 'compiled-program-error
- :condition condition
- :source source)))
+ `(error 'compiled-program-error
+ :message ,(princ-to-string condition)
+ :source ,(princ-to-string source)))
;;; the condition of COMPILE-FILE being unable to READ from the
;;; source file
(handler-case
(sb!xc:make-load-form constant (make-null-lexenv))
(error (condition)
- (compiler-error 'make-load-form-error
- :condition condition
- :object constant)))
+ (compiler-error condition)))
(case creation-form
(:sb-just-dump-it-normally
(fasl-validate-structure constant *compile-object*)
EOF
expect_failed_compile $tmpfilename
+# This should fail, and fail nicely -- not eg. loop trying to dump
+# references to the unbound variable.
+cat > $tmpfilename <<EOF
+(defmacro macro-with-unbound-variables (foo)
+ `(print ,bar))
+
+(macro-with-unbound-variables 'xxx)
+EOF
+expect_failed_compile $tmpfilename
+
+# This should fail, as the MAKE-LOAD-FORM must be used for
+# externalizing conditions, and the method for CONDITION must signal
+# an error.
+cat > $tmpfilename <<EOF
+(defvar *oops* #.(make-condition 'condition))
+EOF
+expect_failed_compile $tmpfilename
+
+# This should fail, as the MAKE-LOAD-FORM must be used for objects,
+# and the method for STANDARD.OBJECT is required to signal an error.
+cat > $tmpfilename <<EOF
+(defvar *oops* #.(make-instance 'standard-object))
+EOF
+expect_failed_compile $tmpfilename
+
rm $tmpfilename
rm $compiled_tmpfilename
;;; 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.12.20"
+"0.8.12.21"
projects / sbcl.git / commitdiff