+ (when files
+ (format t "// Running pure tests (~a)~%" test-fun)
+ (let ((*package* (find-package :cl-user))
+ (*failures* nil))
+ (setup-cl-user)
+ (dolist (file files)
+ (format t "// Running ~a~%" file)
+ (restart-case
+ (handler-bind ((error (make-error-handler file)))
+ (eval (funcall test-fun file)))
+ (skip-file ())))
+ (append-failures))))
+
+(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*))