X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=556b64974279800710c2bcad5c3efa3b77a7fad5;hb=32d3b398d33736e61b51a14afca8c14decec4437;hp=80eaf385a4ff8b3bec53fa9a9a381e7bd790db76;hpb=b8a2248d3193902592fb58c5ea74209dc1124f08;p=sbcl.git

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index 80eaf38..556b649 100644
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -17,6 +17,7 @@
 
 (defvar *all-failures* nil)
 (defvar *break-on-error* nil)
+(defvar *report-skipped-tests* nil)
 (defvar *accept-files* nil)
 
 (defun run-all ()
@@ -26,6 +27,8 @@
            (setf test-util:*break-on-failure* t))
           ((string= arg "--break-on-expected-failure")
            (setf test-util:*break-on-expected-failure* t))
+          ((string= arg "--report-skipped-tests")
+           (setf *report-skipped-tests* t))
           (t
            (push (truename (parse-namestring arg)) *accept-files*))))
   (pure-runner (pure-load-files) #'load-test)
@@ -41,27 +44,40 @@
 (defun report ()
   (terpri)
   (format t "Finished running tests.~%")
-  (cond (*all-failures*
-         (format t "Status:~%")
-         (dolist (fail (reverse *all-failures*))
-           (cond ((eq (car fail) :unhandled-error)
-                  (format t " ~20a ~a~%"
-                          "Unhandled error"
-                          (enough-namestring (second fail))))
-                 ((eq (car fail) :invalid-exit-status)
-                  (format t " ~20a ~a~%"
-                          "Invalid exit status:"
-                          (enough-namestring (second fail))))
-                 (t
-                  (format t " ~20a ~a / ~a~%"
-                          (ecase (first fail)
-                            (:expected-failure "Expected failure:")
-                            (:unexpected-failure "Failure:")
-                            (:unexpected-success "Unexpected success:"))
-                          (enough-namestring (second fail))
-                          (third fail))))))
-        (t
-         (format t "All tests succeeded~%"))))
+  (let ((skipcount 0))
+    (cond (*all-failures*
+           (format t "Status:~%")
+           (dolist (fail (reverse *all-failures*))
+             (cond ((eq (car fail) :unhandled-error)
+                    (format t " ~20a ~a~%"
+                            "Unhandled error"
+                            (enough-namestring (second fail))))
+                   ((eq (car fail) :invalid-exit-status)
+                    (format t " ~20a ~a~%"
+                            "Invalid exit status:"
+                            (enough-namestring (second fail))))
+                   ((eq (car fail) :skipped-disabled)
+                    (when *report-skipped-tests*
+                      (format t " ~20a ~a / ~a~%"
+                              "Skipped (irrelevant):"
+                              (enough-namestring (second fail))
+                              (third fail)))
+                    (incf skipcount))
+                   (t
+                    (format t " ~20a ~a / ~a~%"
+                            (ecase (first fail)
+                              (:expected-failure "Expected failure:")
+                              (:unexpected-failure "Failure:")
+                              (:unexpected-success "Unexpected success:")
+                              (:skipped-broken "Skipped (broken):")
+                              (:skipped-disabled "Skipped (irrelevant):"))
+                            (enough-namestring (second fail))
+                            (third fail)))))
+           (when (> skipcount 0)
+             (format t " (~a tests skipped for this combination of platform and features)~%"
+                     skipcount)))
+          (t
+           (format t "All tests succeeded~%")))))
 
 (defun pure-runner (files test-fun)
   (format t "// Running pure tests (~a)~%" test-fun)
@@ -78,32 +94,24 @@
     (append-failures)))
 
 (defun run-in-child-sbcl (load-forms forms)
-  (declare (ignorable load-forms))
-  #-win32
-  (let ((pid (sb-posix:fork)))
-    (cond ((= pid 0)
-           (dolist (form forms)
-             (eval form)))
-          (t
-           (let ((status (make-array 1 :element-type '(signed-byte 32))))
-             (sb-posix:waitpid pid 0 status)
-             (if (sb-posix:wifexited (aref status 0))
-                 (sb-posix:wexitstatus (aref status 0))
-                 1)))))
-  #+win32
+  ;; We used to fork() for POSIX platforms, and use this for Windows.
+  ;; However, it seems better to use the same solution everywhere.
   (process-exit-code
-   (sb-ext:run-program
-    (first *POSIX-ARGV*)
-    (append
-     (list "--core" SB-INT:*CORE-STRING*
-           "--noinform"
-           "--no-sysinit"
-           "--no-userinit")
-     (loop for form in (append load-forms forms)
-           collect "--eval"
-           collect (write-to-string form)))
-    :output sb-sys:*stdout*
-    :input sb-sys:*stdin*)))
+   (#-win32 with-open-file #-win32 (devnull "/dev/null") #+win32 progn
+     (sb-ext:run-program
+      (first *POSIX-ARGV*)
+      (append
+       (list "--core" SB-INT:*CORE-STRING*
+             "--noinform"
+             "--no-sysinit"
+             "--no-userinit"
+             "--noprint"
+             "--disable-debugger")
+       (loop for form in (append load-forms forms)
+             collect "--eval"
+             collect (write-to-string form)))
+      :output sb-sys:*stdout*
+      :input #-win32 devnull #+win32 sb-sys:*stdin*))))
 
 (defun run-impure-in-child-sbcl (test-file test-code)
   (run-in-child-sbcl
@@ -124,13 +132,14 @@
         (restart-case
             (handler-bind
                 ((error (lambda (condition)
-                          (push (list :unhandled-error cl-user::file) test-util::*failures*)
+                          (push (list :unhandled-error file)
+                                test-util::*failures*)
                           (cond (*break-on-error*
                                  (test-util:really-invoke-debugger condition))
                                 (t
                                  (format *error-output* "~&Unhandled ~a: ~a~%"
                                          (type-of condition) condition)
-                                 (funcall (symbol-function (intern "BACKTRACE" :sb-debug)))))
+                                 (sb-debug:backtrace)))
                           (invoke-restart 'skip-file))))
               ,test-code)
           (skip-file ()
@@ -172,7 +181,9 @@
 (defun unexpected-failures ()
   (remove-if (lambda (x)
                (or (eq (car x) :expected-failure)
-                   (eq (car x) :unexpected-success)))
+                   (eq (car x) :unexpected-success)
+                   (eq (car x) :skipped-broken)
+                   (eq (car x) :skipped-disabled)))
              *all-failures*))
 
 (defun setup-cl-user ()
@@ -194,8 +205,11 @@
 (defun sh-test (file)
   ;; What? No SB-POSIX:EXECV?
   `(let ((process (sb-ext:run-program "/bin/sh"
-                                      (list (namestring ,file))
+                                      (list (native-namestring ,file))
+                                      :environment (test-util::test-env)
                                       :output *error-output*)))
+     (let ((*failures* nil))
+       (test-util:report-test-status))
      (sb-ext:quit :unix-status (process-exit-code process))))
 
 (defun accept-test-file (file)