X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=42b2ec08049b360f89ba0ba072ad4da9b6fb7b88;hb=b4a85c101536166d4b6521d3a28d5cef5937dc6b;hp=cbc28020d9d138e8bd193efd27474b71f0bd2b30;hpb=95a014cffbb243fdc59adbdd6ab7f6dbb0058ca4;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index cbc2802..42b2ec0 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -14,7 +14,7 @@
 (load "assertoid.lisp")
 
 (defpackage "CLOS-IMPURE"
-  (:use "CL" "ASSERTOID"))
+  (:use "CL" "ASSERTOID" "TEST-UTIL"))
 (in-package "CLOS-IMPURE")
 
 ;;; It should be possible to do DEFGENERIC and DEFMETHOD referring to
@@ -1177,6 +1177,28 @@
           (assert (equal (list (slot-value c1 'class-slot)
                                (slot-value c2 'class-slot))
                    (list 1 1))))))
-
+
+;;; tests of ctors on anonymous classes
+(defparameter *unnamed* (defclass ctor-unnamed-literal-class () ()))
+(setf (class-name *unnamed*) nil)
+(setf (find-class 'ctor-unnamed-literal-class) nil)
+(defparameter *unnamed2* (defclass ctor-unnamed-literal-class2 () ()))
+(defun ctor-unnamed-literal-class ()
+  (make-instance '#.*unnamed*))
+(compile 'ctor-unnamed-literal-class)
+(defun ctor-unnamed-literal-class2 ()
+  (make-instance '#.(find-class 'ctor-unnamed-literal-class2)))
+(compile 'ctor-unnamed-literal-class2)
+(defun ctor-unnamed-literal-class2/symbol ()
+  (make-instance 'ctor-unnamed-literal-class2))
+(compile 'ctor-unnamed-literal-class2/symbol)
+(setf (class-name *unnamed2*) nil)
+(setf (find-class 'ctor-unnamed-literal-class2) nil)
+(with-test (:name (:ctor :unnamed-before))
+  (assert (typep (ctor-unnamed-literal-class) *unnamed*)))
+(with-test (:name (:ctor :unnamed-after))
+  (assert (typep (ctor-unnamed-literal-class2) *unnamed2*)))
+(with-test (:name (:ctor :unnamed-after/symbol))
+  (assert (raises-error? (ctor-unnamed-literal-class2/symbol))))
+
 ;;;; success
-(sb-ext:quit :unix-status 104)