X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=8cb583f67656bda3ccd317d03711769030b60b07;hb=4ce92c253dbf6a5275ef3cafc193add284bc9795;hp=3f2bd7738273f23d42da1790deaae9a98d3406aa;hpb=2a44956e41c9d6dcec57eb5719b9a211c9b7c56f;p=sbcl.git

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index 3f2bd77..8cb583f 100644
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -78,32 +78,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
@@ -123,18 +115,19 @@
         (format t "// Running ~a~%" file)
         (restart-case
             (handler-bind
-  	        ((error (lambda (condition)
-                          (push (list :unhandled-error cl-user::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)))))
-			  (invoke-restart 'skip-file))))
+                ((error (lambda (condition)
+                          (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)
+                                 (sb-debug:backtrace)))
+                          (invoke-restart 'skip-file))))
               ,test-code)
-	  (skip-file ()
-	    (format t ">>>~a<<<~%" test-util::*failures*)))
+          (skip-file ()
+            (format t ">>>~a<<<~%" test-util::*failures*)))
         (test-util:report-test-status)
         (sb-ext:quit :unix-status 104)))))
 
@@ -145,7 +138,7 @@
     (dolist (file files)
       (when (accept-test-file file)
         (force-output)
-	(let ((exit-code (run-impure-in-child-sbcl file
+        (let ((exit-code (run-impure-in-child-sbcl file
                                                    (funcall test-fun file))))
           (if (= exit-code 104)
               (with-open-file (stream "test-status.lisp-expr"
@@ -185,17 +178,18 @@
 (defun cload-test (file)
   `(let ((compile-name (compile-file-pathname ,file)))
      (unwind-protect
-	  (progn
-	    (compile-file ,file)
-	    (load compile-name))
+          (progn
+            (compile-file ,file)
+            (load compile-name))
        (ignore-errors
-	 (delete-file compile-name)))))
+         (delete-file compile-name)))))
 
 (defun sh-test (file)
   ;; What? No SB-POSIX:EXECV?
   `(let ((process (sb-ext:run-program "/bin/sh"
-				      (list (namestring ,file))
-				      :output *error-output*)))
+                                      (list (native-namestring ,file))
+                                      :environment (test-util::test-env)
+                                      :output *error-output*)))
      (sb-ext:quit :unix-status (process-exit-code process))))
 
 (defun accept-test-file (file)