Test sb-introspect just like all the other contribs

contrib/sb-introspect/sb-introspect.asd

@@ -16,52 +16,4 @@
   :components ((:file "introspect"))
   #+sb-building-contrib :pathname
   #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;"
-  :perform (load-op :after (o c) (provide 'sb-introspect))
-  :in-order-to ((test-op (test-op "sb-introspect/tests"))))
-
-(defclass plist-file (cl-source-file)
-  ((source-plist
-    :initform nil
-    :initarg :source-plist
-    :reader plist-file-source-plist)))
-
-(defmethod perform ((op compile-op) (com plist-file))
-  (with-compilation-unit (:source-plist (plist-file-source-plist com))
-    (call-next-method)))
-
-(defmethod perform ((op load-op) (com plist-file))
-  (with-compilation-unit (:source-plist (plist-file-source-plist com))
-    (call-next-method)))
-
-(defsystem "sb-introspect/tests"
-  :depends-on ("sb-introspect" "sb-rt")
-  #+sb-building-contrib :pathname
-  #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;"
-  :components ((:file "xref-test-data")
-               (:file "xref-test" :depends-on ("xref-test-data"))
-               (:plist-file "test" :source-plist (:test-outer "OUT") :operation-done-p (compile-op (o c) nil))
-               (:file "test-driver" :depends-on ("test")))
-  :perform
-  (test-op (o c)
-    ;; N.b. At least DEFINITION-SOURCE-PLIST.1 assumes that CWD is the
-    ;; contrib/sb-introspect directory which is true for when this is
-    ;; implicitly run via make-target-contribs.sh -- but not when this
-    ;; is executed manually.
-    (let ((*default-pathname-defaults* (translate-logical-pathname (system-source-directory c))))
-      (multiple-value-bind (soft strict pending) (symbol-call :sb-rt :do-tests)
-        (declare (ignorable pending))
-        (fresh-line)
-        (unless strict
-          #+sb-testing-contrib
-          ;; We create TEST-PASSED from a shell script if tests passed.  But
-          ;; since the shell script only `touch'es it, we can actually create
-          ;; it ahead of time -- as long as we're certain that tests truly
-          ;; passed, hence the check for SOFT.
-          (when soft
-            (with-open-file (s #p"SYS:CONTRIB;SB-INTROSPECT;TEST-PASSED"
-                               :direction :output)
-              (dolist (pend pending)
-                (format s "Expected failure: ~A~%" pend))))
-          (warn "ignoring expected failures in test-op"))
-        (unless soft
-          (error "test-op failed with unexpected failures"))))))
+  :perform (load-op :after (o c) (provide 'sb-introspect)))

contrib/sb-introspect/test-driver.lisp

@@ -8,16 +8,11 @@
 ;;;; files for more information.
 
 (defpackage :sb-introspect-test
-  (:use "SB-INTROSPECT" "CL" "SB-RT"))
+  (:import-from #:test-util #:deftest)
+  (:use "SB-INTROSPECT" "CL"))
 
 (in-package :sb-introspect-test)
 
-(defmacro deftest* ((name &key fails-on) form &rest results)
-  `(progn
-     (when (sb-impl::featurep ',fails-on)
-       (pushnew ',name sb-rt::*expected-failures*))
-     (deftest ,name ,form ,@results)))
-
 ;; When running the tests which query for a function type, sb-interpreter
 ;; can return an answer if there were type declarations for the arguments,
 ;; except that return type is always unknown. The compiler returns a
@@ -52,6 +47,10 @@
            '(x b))
   t)
 
+(defmacro interpret (form)
+  `(let ((sb-ext:*evaluator-mode* :interpret))
+     (eval ',form)))
+
 #+sb-eval
 (deftest macro-lambda-list.2
     (equal (function-lambda-list (interpret (defmacro macro-lambda-list.2-m (x)
@@ -90,18 +89,13 @@
                   plist)))
   t t t)
 
-;; Not sure why this fails when interpreted, and don't really care too much.
-;; The behavior seems right to me anyway.
-#.(if (eq sb-ext:*evaluator-mode* :compile)
-'(deftest definition-source-plist.2
+;;; The behavior of :SOURCE-PLIST on nested WITH-COMPILATION-UNIT
+;;; is to append. This is documented in source/compiler/main
+(test-util:with-test (:name :definition-source-plist.2)
     (let ((plist (definition-source-plist
                      (find-definition-source #'cl-user::four))))
-      (values (or (equal (getf plist :test-outer) "OUT")
-                  plist)
-              (or (equal (getf plist :test-inner) "IN")
-                  plist)))
-  t t)
-(values))
+      (assert (equal (getf plist :test-outer) "OUT"))
+      (assert (equal (getf plist :test-inner) "IN"))))
 
 (defun matchp (object form-number)
   (let ((ds (sb-introspect:find-definition-source object)))
@@ -393,7 +387,7 @@
 ;;; affected builds, even if the underlying issue is (possibly?) not even
 ;;; strictly related to windows.  C.f. lp1057631.  --DFL
 ;;;
-(deftest* (allocation-information.4
+(test-util:with-test (:name :allocation-information.4
            ;; Ignored as per the comment above, even though it seems
            ;; unlikely that this is the right condition.
            :fails-on (or :win32 :ppc64 (and :sparc :gencgc)))
@@ -466,7 +460,7 @@
 (compile 'alloc-large-code)
 
 #+gencgc
-(deftest* (allocation-information.6)
+(deftest allocation-information.6
     ;; Remember, all tests run after all toplevel forms have executed,
     ;; so if this were (DEFGLOBAL *LARGE-CODE* ... ) or something,
     ;; the garbage collection explicitly requested for ALLOCATION-INFORMATION.5
@@ -563,10 +557,6 @@
       (sb-kernel:type= (sb-kernel:values-specifier-type typespec1)
                        (sb-kernel:values-specifier-type typespec2))))
 
-(defmacro interpret (form)
-  `(let ((sb-ext:*evaluator-mode* :interpret))
-     (eval ',form)))
-
 ;; Functions
 
 (declaim (ftype (function (integer &optional string) string) moon))

contrib/sb-introspect/xref-test-data.lisp

@@ -8,7 +8,8 @@
 ;;;; files for more information.
 
 (defpackage :sb-introspect-test/xref
-  (:use "SB-INTROSPECT" "CL" "SB-RT"))
+  (:import-from #:test-util #:deftest)
+  (:use "SB-INTROSPECT" "CL"))
 
 (in-package :sb-introspect-test/xref)
 

tests/input-manifest.lisp-expr

@@ -95,6 +95,10 @@
  ("sb-cover.impure.lisp" "contrib/sb-cover.fasl")
  ("sb-gmp.impure.lisp" "contrib/sb-gmp.fasl" "../contrib/sb-gmp/tests.lisp")
  ("sb-graph.impure.lisp" "contrib/sb-graph.fasl" "contrib/uiop.fasl")
+ ("sb-introspect.impure.lisp" "contrib/sb-introspect.fasl"
+  "../contrib/sb-introspect/xref-test-data.lisp" "../contrib/sb-introspect/xref-test.lisp"
+  "../contrib/sb-introspect/test.lisp" "../contrib/sb-introspect/test-driver.lisp"
+  "../contrib/sb-introspect/load-test.lisp")
  ("sb-md5.impure.lisp" "contrib/sb-md5.fasl" "contrib/sb-rotate-byte.fasl"
   "../contrib/sb-md5/md5-tests.lisp")
  ("sb-mpfr.impure.lisp" "contrib/sb-gmp.fasl" "contrib/sb-mpfr.fasl"

tests/sb-introspect.impure.lisp

@@ -0,0 +1,15 @@
+(require :sb-introspect)
+(test-util:with-scratch-file (f "fasl")
+  (load (compile-file "../contrib/sb-introspect/xref-test-data.lisp" :output-file f))
+  (load "../contrib/sb-introspect/xref-test.lisp")
+ ;; This test is quite bogus. because it depended on WITH-COMPILATION-UNIT
+ ;; being wrapped around both the COMPILE-FILE and LOAD which is very weird.
+ ;; If we take the W-C-U out from the LOAD, then the assertions on CL-USER::FOUR
+ ;; fails because we don't append property lists. And if we don't COMPILE-FILE,
+ ;; then we lose information about COMPILE-TIME-TOO-FUN. As written, it's hard to
+ ;; assert about behaviors that actually occur in each step.
+ ;; If someone thinks this is an important distinction, that someone can
+ ;; write better tests.
+ (with-compilation-unit (:source-plist '(:test-outer "OUT"))
+   (load (compile-file "../contrib/sb-introspect/test.lisp" :output-file f)))
+ (load "../contrib/sb-introspect/test-driver.lisp"))

tests/sb-introspect.test.sh

@@ -1,10 +0,0 @@
-#!/bin/sh
-. ./subr.sh
-run_sbcl <<EOF
-  (setq *features* (append sb-impl:+internal-features+ *features*))
-  (push :sb-testing-contrib *features*)
-  (require :asdf)
-  (let ((*package* (find-package "ASDF"))) (load "../contrib/sb-introspect/sb-introspect.asd"))
-  (asdf:test-system "sb-introspect/tests")
-  (exit :code $EXIT_TEST_WIN)
-EOF