+(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
+ (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*)))
+
+(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*))
+ (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:quit :unix-status 104)))))
+