From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 11 Apr 2011 10:52:03 +0000 (+0000)
Subject: 1.0.47.23: remove defknowns for condition slot accessors
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b4ddf569d48686d532f3baf62f1c5cd42d78f9bd;p=sbcl.git

1.0.47.23: remove defknowns for condition slot accessors

  Condition slot types aren't checked, and DEFINE-CONDITION throws the
  fndb type-information out of the window -- but the defknowns cause
  code compiled before that to trust the types.

  Fixes lp#705690.
---

diff --git a/NEWS b/NEWS
index 5a652f0..67170de 100644
--- a/NEWS
+++ b/NEWS
@@ -24,6 +24,8 @@ changes relative to sbcl-1.0.47:
     of DEFUN. (lp#675584)
   * bug fix: --dynamic-space-size argument is validated more carefully.
     (lp#721457)
+  * bug fix: memory fault from printing a malformed simple-condition.
+    (lp#705690)
 
 changes in sbcl-1.0.47 relative to sbcl-1.0.46:
   * bug fix: fix mach port rights leaks in mach exception handling code on
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 8d8f52e..77be6fa 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1270,16 +1270,11 @@
 
 ;;;; from the "Conditions" chapter:
 
-(defknown cell-error-name (cell-error) t)
 (defknown error (t &rest t) nil)
 (defknown cerror (format-control t &rest t) null)
 (defknown invalid-method-error (t format-control &rest t) *) ; FIXME: first arg is METHOD
 (defknown method-combination-error (format-control &rest t) *)
 (defknown signal (t &rest t) null)
-(defknown simple-condition-format-control (condition)
-  (or null format-control))
-(defknown simple-condition-format-arguments (condition)
-  list)
 (defknown warn (t &rest t) null)
 (defknown invoke-debugger (condition) nil)
 (defknown break (&optional format-control &rest t) null)
diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index dc6877d..0b071d8 100644
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -179,3 +179,13 @@
                         (eq sc (car
                                 (simple-condition-format-arguments c))))
                :ok)))))))
+
+(with-test (:name :malformed-simple-condition-printing-type-error)
+  (assert (eq :type-error
+              (handler-case
+                  (princ-to-string
+                   (make-condition 'simple-error :format-control "" :format-arguments 8))
+                (type-error (e)
+                  (when (and (eq 'list (type-error-expected-type e))
+                             (eql 8 (type-error-datum e)))
+                    :type-error))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 1aa75b7..6e2883f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; 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".)
-"1.0.47.22"
+"1.0.47.23"