X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=ae0fee2618d17f655f94d808117f3b9608967ebb;hb=e1905b479292158bd2bacdebb81e27b4da041097;hp=3f2bd7738273f23d42da1790deaae9a98d3406aa;hpb=2a44956e41c9d6dcec57eb5719b9a211c9b7c56f;p=sbcl.git diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 3f2bd77..ae0fee2 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -123,18 +123,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 +146,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 +186,17 @@ (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 (namestring ,file)) + :output *error-output*))) (sb-ext:quit :unix-status (process-exit-code process)))) (defun accept-test-file (file)