From bb9b382751d808c76592ce2484c33f8447db6568 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 18 May 2012 22:42:17 +0300 Subject: [PATCH] COMPILED-PROGRAM-ERROR source form needs *PRINT-ESCAPE* PRINC-TO-STRING is not what we want here. --- NEWS | 2 ++ src/compiler/compiler-error.lisp | 7 ++++++- tests/compiler.pure.lisp | 8 ++++++++ 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 0acdd06..9513f4f 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ changes relative to sbcl-1.0.57: updates of CAS-able places (similar to Clojure's swap!). * bug fix: potential for infinite recursion during compilation of CLOS slot typechecks when dependency graph had loops. (lp#1001799) + * bug fix: error forms reported with some program-errors were not escaped + properly. changes in sbcl-1.0.57 relative to sbcl-1.0.56: * RANDOM enhancements and bug fixes: diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp index f3b5426..4316041 100644 --- a/src/compiler/compiler-error.lisp +++ b/src/compiler/compiler-error.lisp @@ -108,10 +108,15 @@ (apply #'style-warn datum arguments) (values)) +(defun source-to-string (source) + (write-to-string source + :escape t :readably nil :pretty t + :circle t :array nil)) + (defun make-compiler-error-form (condition source) `(error 'compiled-program-error :message ,(princ-to-string condition) - :source ,(princ-to-string source))) + :source ,(source-to-string source))) ;;; Fatal compiler errors. We export FATAL-COMPILER-ERROR as an ;;; interface for errors that kill the compiler dead diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 780b3d2..cd14e50 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4274,3 +4274,11 @@ (with-test (:name :malformed-type-declaraions) (compile nil '(lambda (a) (declare (type (integer 1 2 . 3) a))))) + +(with-test (:name :compiled-program-error-escaped-source) + (assert + (handler-case + (funcall (compile nil `(lambda () (lambda ("foo"))))) + (sb-int:compiled-program-error (e) + (let ((source (read-from-string (sb-kernel::program-error-source e)))) + (equal source '#'(lambda ("foo")))))))) -- 1.7.10.4