[Sbcl-commits] master: Fix bug in collecting condition-classoid-class-slots

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  1891fa69bddd2cab9180b3fa9c7fcb3206174790 (commit)
      from  65a44db5d5c3c4079a44a572d3a43743ecfc1b1d (commit)

- Log -----------------------------------------------------------------
commit 1891fa69bddd2cab9180b3fa9c7fcb3206174790
Author: Douglas Katzman <do...@go...>
Date:   Wed Nov 19 23:29:18 2014 -0500

    Fix bug in collecting condition-classoid-class-slots
    
    Also fix test from 5c6f48ae which wasn't testing anything.
---
 src/code/condition.lisp     |    5 +++--
 tests/condition.impure.lisp |   21 ++++++++++++++++++++-
 2 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 17a9844..7f8af8b 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -416,7 +416,7 @@
     (sb!c:with-source-location (source-location)
       (setf (layout-source-location layout)
             source-location))
-    (let ((class (find-classoid name)))
+    (let ((class (find-classoid name))) ; FIXME: rename to 'classoid'
       (setf (condition-classoid-slots class) slots
             (condition-classoid-direct-default-initargs class) direct-default-initargs
             (fdocumentation name 'type) documentation)
@@ -432,7 +432,8 @@
 
       ;; Compute effective slots and set up the class and hairy slots
       ;; (subsets of the effective slots.)
-      (setf (condition-classoid-hairy-slots class) '())
+      (setf (condition-classoid-class-slots class) '()
+            (condition-classoid-hairy-slots class) '())
       (let ((eslots (compute-effective-slots class))
             (e-def-initargs
              (reduce #'append
diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp
index b3e0c38..66ebf65 100644
--- a/tests/condition.impure.lisp
+++ b/tests/condition.impure.lisp
@@ -404,7 +404,26 @@
 (defun case-failure-example (x) (etypecase x (function 1) (symbol 2)))
 ;; The :report method should not print "wanted one of #'SYMBOL"
 (with-test (:name :case-failure-report-pprint-silliness)
-  (handler-case (foo 3)
+  (handler-case (case-failure-example 3)
     (condition (c)
       (let ((str (write-to-string c :escape nil :pretty t)))
         (assert (not (search "#'SYMBOL" str)))))))
+
+(define-condition a-condition-with-a-classy-slot ()
+  ((a :allocation :class :initform 'foo)))
+
+(defvar *a-classy-classoid*
+  (sb-kernel:find-classoid 'a-condition-with-a-classy-slot))
+;; precondition to the test
+(assert (= (length (sb-kernel::condition-classoid-class-slots
+                    *a-classy-classoid*))
+           1))
+
+(define-condition a-condition-with-a-classy-slot ()
+  ((b :allocation :class :initform 'baz)
+   (a :allocation :class :initform 'foo)))
+
+(with-test (:name :condition-classoid-redef-with-class-slot)
+  (assert (= (length (sb-kernel::condition-classoid-class-slots
+                      *a-classy-classoid*))
+             2)))

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


hooks/post-receive
-- 
SBCL