0.9.18.32: room test that was supposed to be in 0.9.18.31

[sbcl.git] / tests / clos.impure.lisp

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 84c7ec3..0bef77f 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -11,8 +11,6 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-(load "assertoid.lisp")
-
 (defpackage "CLOS-IMPURE"
   (:use "CL" "ASSERTOID" "TEST-UTIL"))
 (in-package "CLOS-IMPURE")
@@ -654,6 +652,7 @@
 (assert (= (bug222 t) 1))
 
 ;;; also, a test case to guard against bogus environment hacking:
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setq bug222-b 3))
 ;;; this should at the least compile:
@@ -664,8 +663,10 @@
 ;;; and it would be nice (though not specified by ANSI) if the answer
 ;;; were as follows:
 (let ((x (make-string-output-stream)))
-  ;; not specified by ANSI
-  (assert (= (bug222-b t x) 3))
+  (let ((value (bug222-b t x)))
+    ;; not specified by ANSI
+    #+#.(cl:if (cl:eq sb-ext:*evaluator-mode* :compile) '(and) '(or))
+    (assert (= value 3)))
   ;; specified.
   (assert (char= (char (get-output-stream-string x) 0) #\1)))
 \f
@@ -1383,4 +1384,21 @@
 (make-instances-obsolete (find-class 'obsolete-again))
 (assert (not (is-a-structure-object-p *obsolete-again*)))
 \f
+;;; overeager optimization of slot-valuish things
+(defclass listoid ()
+  ((caroid :initarg :caroid)
+   (cdroid :initarg :cdroid :initform nil)))
+(defmethod lengthoid ((x listoid))
+  (let ((result 0))
+    (loop until (null x)
+          do (incf result) (setq x (slot-value x 'cdroid)))
+    result))
+(with-test (:name ((:setq :method-parameter) slot-value))
+  (assert (= (lengthoid (make-instance 'listoid)) 1))
+  (assert (= (lengthoid
+              (make-instance 'listoid :cdroid
+                             (make-instance 'listoid :cdroid
+                                            (make-instance 'listoid))))
+             3)))
+\f
 ;;;; success