+(defun run-in-child-sbcl (load-forms forms)
+ ;; 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
+ (#-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
+ `((load "test-util")
+ (load "assertoid")
+ (defpackage :run-tests
+ (:use :cl :test-util :sb-ext)))
+
+ `((in-package :cl-user)
+ (use-package :test-util)
+ (use-package :assertoid)
+ (setf test-util:*break-on-failure* ,test-util:*break-on-failure*)
+ (setf test-util:*break-on-expected-failure*
+ ,test-util:*break-on-expected-failure*)
+ (let ((file ,test-file)
+ (*break-on-error* ,run-tests::*break-on-error*))
+ (declare (special *break-on-error*))
+ (format t "// Running ~a~%" file)
+ (restart-case
+ (handler-bind
+ ((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*)))
+ (test-util:report-test-status)
+ (sb-ext:exit :code 104)))))
+