[Sbcl-commits] CVS: sbcl/tests clos.impure.lisp, 1.99, 1.100 load.impure.lisp, 1.7, 1.8 type.pure.lisp, 1.37, 1.38

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv6027/tests

Modified Files:
	clos.impure.lisp load.impure.lisp type.pure.lisp 
Log Message:
1.0.23.55: three stale bugs

 * 332, 369, 380: added test-cases which pass.


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -d -r1.99 -r1.100
--- clos.impure.lisp	6 Oct 2008 09:14:27 -0000	1.99
+++ clos.impure.lisp	19 Dec 2008 13:46:34 -0000	1.100
@@ -1639,5 +1639,13 @@
   (handler-bind ((compiler-note #'error))
     (stream-fd sb-sys:*stdin* :output)
     (stream-fd sb-sys:*stdin* :output)))
+
+(with-test (:name :bug-380)
+  (defclass bug-380 ()
+    ((slot :accessor bug380-slot)))
+  (fmakunbound 'foo-slot)
+  (defgeneric foo-slot (x y z))
+  (defclass foo ()
+    ((slot :accessor foo-slot-value))))
 
 ;;;; success

Index: load.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/load.impure.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- load.impure.lisp	17 Dec 2007 23:00:23 -0000	1.7
+++ load.impure.lisp	19 Dec 2008 13:46:34 -0000	1.8
@@ -271,3 +271,20 @@
                                    (when (find-restart 'sb-fasl::object)
                                      (invoke-restart 'sb-fasl::object)))))
       (load-and-assert spec fasl fasl))))
+
+(with-test (:name :bug-332)
+  (flet ((stimulate-sbcl ()
+           (let ((filename (format nil "/tmp/~A.lisp" (gensym))))
+             ;; create a file which redefines a structure incompatibly
+             (with-open-file (f filename :direction :output :if-exists :supersede)
+               (print '(defstruct bug-332 foo) f)
+               (print '(defstruct bug-332 foo bar) f))
+             ;; compile and load the file, then invoke the continue restart on
+             ;; the structure redefinition error
+             (handler-bind ((error (lambda (c) (continue c))))
+               (load (compile-file filename))))))
+    (stimulate-sbcl)
+    (stimulate-sbcl)
+    (stimulate-sbcl)))
+
+

Index: type.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/type.pure.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- type.pure.lisp	5 Aug 2008 16:29:13 -0000	1.37
+++ type.pure.lisp	19 Dec 2008 13:46:34 -0000	1.38
@@ -400,3 +400,23 @@
 (with-test (:name :opt+rest+key-canonicalization)
   (let ((type '(function (&optional t &rest t &key (:x t) (:y t)) *)))
     (assert (equal type (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
+
+(with-test (:name :bug-369)
+  (let ((types (mapcar #'sb-c::values-specifier-type
+                       '((values (vector package) &optional)
+                         (values (vector package) &rest t)
+                         (values (vector hash-table) &rest t)
+                         (values (vector hash-table) &optional)
+                         (values t &optional)
+                         (values t &rest t)
+                         (values nil &optional)
+                         (values nil &rest t)
+                         (values sequence &optional)
+                         (values sequence &rest t)
+                         (values list &optional)
+                         (values list &rest t)))))
+    (dolist (x types)
+      (dolist (y types)
+        (let ((i (sb-c::values-type-intersection x y)))
+          (assert (sb-c::type= i (sb-c::values-type-intersection i x)))
+          (assert (sb-c::type= i (sb-c::values-type-intersection i y))))))))