From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 4 Jun 2009 11:28:34 +0000 (+0000)
Subject: 1.0.28.77: fix test failures on PPC and elsewhere
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b1f7d9dcedbd900c3c4d6c171a92f4ae7e075166;p=sbcl.git

1.0.28.77: fix test failures on PPC and elsewhere

* Most of the failures were test that cannot pass due to missing
  bits of DX implementation -- stack allocatable vectors and
  fixed-alloc.

* Mark backtrace test 353 as expected to fail on PPC as well.

* Don't declare *HANDLER-CLUSTERS* as dynamic-extent on platforms
  that do not support DX fixed-alloc, since it will just give
  a spurious compiler note.
---

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index ac72b11..2ad6f6f 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -617,6 +617,9 @@ evaluated as a PROGN."
               (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x)))
                                     mapped-bindings))
                     *handler-clusters*)))
+         ;; KLUDGE: Only on platforms with DX FIXED-ALLOC. FIXME: Add a
+         ;; feature for that, so we can conditionalize on it neatly.
+         #!+(or hppa mips x86 x86-64)
          (declare (truly-dynamic-extent *handler-clusters*))
          (progn ,form)))))
 
diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index 7a2d913..8ba4e91 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -165,7 +165,7 @@
               ;; the presence of the IR1 stepper instrumentation (and
               ;; is thus again failing now that the instrumentation is
               ;; no more).
-              :fails-on '(or :x86 :x86-64 :alpha :mips))
+              :fails-on '(or :x86 :x86-64 :alpha :mips :ppc))
     (assert (verify-backtrace
              (lambda () (test #'not-optimized))
              (list *undefined-function-frame*
diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp
index 4c183bb..0d1992d 100644
--- a/tests/dynamic-extent.impure.lisp
+++ b/tests/dynamic-extent.impure.lisp
@@ -518,30 +518,36 @@
   (assert-no-consing (test-let-var-subst2 17))
   (assert-no-consing (test-lvar-subst 11))
   (assert-no-consing (dx-value-cell 13))
-  (assert-no-consing (cons-on-stack 42))
-  (assert-no-consing (force-make-array-on-stack 128))
-  (assert-no-consing (make-array-on-stack-1))
-  (assert-no-consing (make-array-on-stack-2 5 '(1 2.0 3 4.0 5)))
-  (assert-no-consing (make-array-on-stack-3 9 8 7))
-  (assert-no-consing (make-array-on-stack-4))
-  #+nil
-  (assert-no-consing (make-array-on-stack-5))
-  (assert-no-consing (vector-on-stack :x :y))
-  (assert-no-consing (make-foo1-on-stack 123))
-  (assert-no-consing (nested-good 42))
+  ;; Only for platforms with DX FIXED-ALLOC
+  #+(or hppa mips x86 x86-64)
+  (progn
+    (assert-no-consing (cons-on-stack 42))
+    (assert-no-consing (make-foo1-on-stack 123))
+    (assert-no-consing (nested-good 42))
+    (assert-no-consing (nested-dx-conses))
+    (assert-no-consing (dx-handler-bind 2))
+    (assert-no-consing (dx-handler-case 2)))
+  ;; Only for platforms with DX ALLOCATE-VECTOR
+  #+(or hppa mips x86 x86-64)
+  (progn
+    (assert-no-consing (force-make-array-on-stack 128))
+    (assert-no-consing (make-array-on-stack-1))
+    (assert-no-consing (make-array-on-stack-2 5 '(1 2.0 3 4.0 5)))
+    (assert-no-consing (make-array-on-stack-3 9 8 7))
+    (assert-no-consing (make-array-on-stack-4))
+    #+nil
+    (assert-no-consing (make-array-on-stack-5))
+    (assert-no-consing (vector-on-stack :x :y)))
   (#+raw-instance-init-vops assert-no-consing
    #-raw-instance-init-vops progn
    (make-foo2-on-stack 1.24 1.23d0))
   (#+raw-instance-init-vops assert-no-consing
    #-raw-instance-init-vops progn
    (make-foo3-on-stack))
-  (assert-no-consing (nested-dx-conses))
   (assert-no-consing (nested-dx-lists))
   (assert-consing (nested-dx-not-used *a-cons*))
   (assert-no-consing (nested-evil-dx-used *a-cons*))
   (assert-no-consing (multiple-dx-uses))
-  (assert-no-consing (dx-handler-bind 2))
-  (assert-no-consing (dx-handler-case 2))
   ;; Not strictly DX..
   (assert-no-consing (test-hash-table))
   #+sb-thread
@@ -588,7 +594,10 @@
   (let ((a (make-array 11 :initial-element 0)))
     (declare (dynamic-extent a))
     (assert (every (lambda (x) (eql x 0)) a))))
-(assert-no-consing (bdowning-2005-iv-16))
+(with-test (:name :bdowning-2005-iv-16)
+  #+(or hppa mips x86 x86-64)
+  (assert-no-consing (bdowning-2005-iv-16))
+  (bdowning-2005-iv-16))
 
 (defun-with-dx let-converted-vars-dx-allocated-bug (x y z)
   (let* ((a (list x y z))
@@ -626,7 +635,9 @@
       (multiple-value-bind (y pos2) (read-from-string res nil nil :start pos)
         (assert (equalp f2 y))
         (assert (equalp f3 (read-from-string res nil nil :start pos2))))))
-  (assert-no-consing (assert (eql n (funcall fun nil)))))
+  #+(or hppa mips x86 x86-64)
+  (assert-no-consing (assert (eql n (funcall fun nil))))
+  (assert (eql n (funcall fun nil))))
 (macrolet ((def (n f1 f2 f3)
              (let ((name (sb-pcl::format-symbol :cl-user "DX-FLET-TEST.~A" n)))
                `(progn
diff --git a/version.lisp-expr b/version.lisp-expr
index aef0c48..ef5e1fa 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.76"
+"1.0.28.77"