X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fsb-introspect.asd;h=d547cc67f1a9d8ac8859794d3956f9f9e1f5e7e5;hb=7169796933b86601eaf70d3a9064600730cb2b40;hp=b484c237ed054e737ba9e101c6de28dbaa439981;hpb=d351f80b1076dd54e5aee3dacab82d59c2e58060;p=sbcl.git

diff --git a/contrib/sb-introspect/sb-introspect.asd b/contrib/sb-introspect/sb-introspect.asd
index b484c23..d547cc6 100644
--- a/contrib/sb-introspect/sb-introspect.asd
+++ b/contrib/sb-introspect/sb-introspect.asd
@@ -38,13 +38,45 @@
   (with-compilation-unit (:source-plist (plist-file-source-plist com))
     (call-next-method)))
 
+(defclass source-only-file (cl-source-file)
+  ())
+
+(defmethod perform ((op compile-op) (com source-only-file)))
+
+(defmethod output-files ((op compile-op) (com source-only-file))
+  (list (component-pathname com)))
+
 (defsystem :sb-introspect-tests
   :depends-on (:sb-introspect :sb-rt)
   :components ((:file "xref-test-data")
                (:file "xref-test" :depends-on ("xref-test-data"))
                (:plist-file "test" :source-plist (:test-outer "OUT"))
-               (:file "test-driver" :depends-on ("test"))))
+               (:source-only-file "load-test")
+               (:file "test-driver" :depends-on ("test" "load-test"))))
 
 (defmethod perform ((op test-op) (com (eql (find-system :sb-introspect-tests))))
-  (or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
-      (error "~S failed" 'test-op)))
+  ;; 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*
+         (make-pathname :directory (pathname-directory
+                                    '#.(or *compile-file-pathname*
+                                           *load-pathname*)))))
+    (multiple-value-bind (soft strict pending)
+        (funcall (intern "DO-TESTS" (find-package "SB-RT")))
+      (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")))))