(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
(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)))))
(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"
(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))
+ :output *error-output*)))
(sb-ext:quit :unix-status (process-exit-code process))))
(defun accept-test-file (file)