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

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index f4bacff..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
@@ -1170,13 +1170,35 @@
 (assert (null (r-c/c-m-1-gf)))
 
 (handler-bind ((warning #'error))
-  (eval '(defclass class-for-ctor/class-slot () 
+  (eval '(defclass class-for-ctor/class-slot ()
           ((class-slot :initarg :class-slot :allocation :class))))
   (eval '(let ((c1 (make-instance 'class-for-ctor/class-slot))
                (c2 (make-instance 'class-for-ctor/class-slot :class-slot 1)))
           (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)