X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Ftest-driver.lisp;h=3295ae6783e4cfcfe96b8407145b60e3a4547995;hb=f2db6743b1fadeea9e72cb583d857851c87efcd4;hp=322ca918dcf37dee127a0988b23bbd8814c9599a;hpb=d351f80b1076dd54e5aee3dacab82d59c2e58060;p=sbcl.git

diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp
index 322ca91..3295ae6 100644
--- a/contrib/sb-introspect/test-driver.lisp
+++ b/contrib/sb-introspect/test-driver.lisp
@@ -251,10 +251,17 @@
 
 ;;; Test allocation-information
 
-(defun tai (x kind info)
+(defun tai (x kind info &key ignore)
   (multiple-value-bind (kind2 info2) (sb-introspect:allocation-information x)
     (unless (eq kind kind2)
       (error "wanted ~S, got ~S" kind kind2))
+    (when (not (null ignore))
+      (setf info2 (copy-list info2))
+      (dolist (key ignore)
+        (remf info2 key))
+      (setf info (copy-list info))
+      (dolist (key ignore)
+        (remf info key)))
     (equal info info2)))
 
 (deftest allocation-infromation.1
@@ -270,21 +277,18 @@
   t)
 
 (deftest allocation-information.4
+    #+gencgc
     (tai #'cons :heap
-         #+(and (not ppc) gencgc)
-         ;; FIXME: This is the canonical GENCGC result, the one below for PPC is
-         ;; what we get there, but :LARGE T doesn't seem right. Figure out what's
-         ;; going on.
+         ;; FIXME: This is the canonical GENCGC result. On PPC we sometimes get
+         ;; :LARGE T, which doesn't seem right -- but ignore that for now.
          '(:space :dynamic :generation 6 :write-protected t :pinned nil :large nil)
-         #+(and ppc gencgc)
-         '(:space :dynamic :generation 6 :write-protected t :pinned nil :large t)
-         ;; FIXME: Figure out what's the right cheney-result, and which platforms
-         ;; return something else. The SPARC version here is what we get there,
-         ;; but quite possibly that is the result on all non-GENCGC platforms.
-         #+(and sparc (not gencgc))
-         '(:space :read-only)
-         #+(and (not sparc) (not gencgc))
-         '(:space :dynamic))
+         :ignore #+ppc '(:large) #-ppc nil)
+    #-gencgc
+    (tai :cons :heap
+         ;; FIXME: Figure out what's the right cheney-result. SPARC at least
+         ;; has exhibited both :READ-ONLY and :DYNAMIC, which seems wrong.
+         '()
+         :ignore '(:space))
   t)
 
 #+sb-thread
@@ -320,12 +324,12 @@
                         (sb-thread:wait-on-semaphore sem)))
                     :name "child")))
        (loop until obj)
-       (assert (equal (list :stack child)
-                      (multiple-value-list
-                       (sb-introspect:allocation-information obj))))
-       (sb-thread:signal-semaphore sem)
-       (sb-thread:join-thread child)
-       nil))
+       (unwind-protect
+            (equal (list :stack child)
+                   (multiple-value-list
+                    (sb-introspect:allocation-information obj)))
+         (sb-thread:signal-semaphore sem)
+         (sb-thread:join-thread child))))
 
    (deftest allocation-information.thread.3
        (thread-tai2)