Steel Bank Common Lisp

The branch "master" has been updated in SBCL:
       via  bb9b382751d808c76592ce2484c33f8447db6568 (commit)
      from  126b9cfb25799ca41210c1a1658de30e1ff372e7 (commit)

- Log -----------------------------------------------------------------
commit bb9b382751d808c76592ce2484c33f8447db6568
Author: Nikodemus Siivola <nikodemus@...>
Date:   Fri May 18 22:42:17 2012 +0300

    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 deletions(-)

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"))))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL