[Sbcl-commits] CVS: sbcl/tests compiler.pure.lisp,1.170,1.171

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

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv29062/tests

Modified Files:
	compiler.pure.lisp 
Log Message:
1.0.15.36: fix bug 423

 * TRULY-THE no longer eagerly annotates the LVAR, but rather acts
   like THE in unsafe code. (Inserts a cast for which no type-check is
   generated.)

 * ALLOC-NUMBER-STACK-SPACE and ALLOC-ALIEN-STACK-SPACE were missing
   :RESULT-TYPES, which was masked by the old TRULY-THE
   implementation. (Tested on x86, x86-64, PPC, but all backends
   updated -- hopefully correctly.)

 * Docstrings for THE and TRULY-THE.

 FWIW, this patch seems to make PPC+GENCGC build happy once again: but
 I don't know if that means the problems there were/are related to bug
 423 -- or if the exact memory layout just happens to change subtly so
 that whatever corruption occurs, just happens to occur in a place
 where the GC doesn't see it anymore. (Or if the exact point at which
 GC runs is now just slightly different so that the problem pointers
 are not live anymore, or...)


Index: compiler.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v
retrieving revision 1.170
retrieving revision 1.171
diff -u -d -r1.170 -r1.171
--- compiler.pure.lisp	30 Nov 2007 17:46:10 -0000	1.170
+++ compiler.pure.lisp	17 Mar 2008 17:13:41 -0000	1.171
@@ -2323,3 +2323,22 @@
                (declare (fixnum y) (character x))
                (sb-sys:with-pinned-objects (x y)
                  (some-random-function))))
+
+;;; *CHECK-CONSISTENCY* and TRULY-THE
+
+(with-test (:name :bug-423)
+  (let ((sb-c::*check-consistency* t))
+    (handler-bind ((warning #'error))
+      (flet ((make-lambda (type)
+               `(lambda (x)
+                  ((lambda (z)
+                     (if (listp z)
+                         (let ((q (truly-the list z)))
+                           (length q))
+                         (if (arrayp z)
+                             (let ((q (truly-the vector z)))
+                               (length q))
+                             (error "oops"))))
+                   (the ,type x)))))
+        (compile nil (make-lambda 'list))
+        (compile nil (make-lambda 'vector))))))