X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=3d8c3d4eec5f6eec295dfa8b6515376b79d4d822;hb=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;hp=2cdd1631c976e5fb119882d9da4afdb0fcf39f8d;hpb=69990bc42314706e9d646ddd8f6b911f46d0052c;p=sbcl.git diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 2cdd163..3d8c3d4 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -1,10 +1,5 @@ -#+#.(cl:if (cl:find-package "ASDF") '(or) '(and)) -(load (merge-pathnames "../contrib/asdf/asdf.fasl")) - -#+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and)) -(let ((asdf:*central-registry* - (cons "../contrib/systems/" asdf:*central-registry*))) - (asdf:oos 'asdf:load-op 'sb-posix)) +(handler-bind (#+win32 (warning #'muffle-warning)) + (require :sb-posix)) (load "test-util.lisp") @@ -15,10 +10,12 @@ (in-package run-tests) +(load "colorize.lisp") + (defvar *all-failures* nil) (defvar *break-on-error* nil) (defvar *report-skipped-tests* nil) -(defvar *accept-files* nil) +(defvar *explicit-test-files* nil) (defun run-all () (dolist (arg (cdr *posix-argv*)) @@ -29,8 +26,9 @@ (setf test-util:*break-on-expected-failure* t)) ((string= arg "--report-skipped-tests") (setf *report-skipped-tests* t)) + ((string= arg "--no-color")) (t - (push (truename (parse-namestring arg)) *accept-files*)))) + (push (truename (parse-namestring arg)) *explicit-test-files*)))) (pure-runner (pure-load-files) #'load-test) (pure-runner (pure-cload-files) #'cload-test) (impure-runner (impure-load-files) #'load-test) @@ -50,12 +48,14 @@ (format t "Status:~%") (dolist (fail (reverse *all-failures*)) (cond ((eq (car fail) :unhandled-error) - (format t " ~20a ~a~%" - "Unhandled error" + (output-colored-text (car fail) + " Unhandled Error") + (format t " ~a~%" (enough-namestring (second fail)))) ((eq (car fail) :invalid-exit-status) - (format t " ~20a ~a~%" - "Invalid exit status:" + (output-colored-text (car fail) + " Invalid exit status:") + (format t " ~a~%" (enough-namestring (second fail)))) ((eq (car fail) :skipped-disabled) (when *report-skipped-tests* @@ -65,14 +65,16 @@ (third fail))) (incf skipcount)) (t - (format t " ~20a ~a / ~a~%" - (ecase (first fail) - (:expected-failure "Expected failure:") - (:unexpected-failure "Failure:") - (:leftover-thread "Leftover thread (broken):") - (:unexpected-success "Unexpected success:") - (:skipped-broken "Skipped (broken):") - (:skipped-disabled "Skipped (irrelevant):")) + (output-colored-text + (first fail) + (ecase (first fail) + (:expected-failure " Expected failure:") + (:unexpected-failure " Failure:") + (:leftover-thread " Leftover thread (broken):") + (:unexpected-success " Unexpected success:") + (:skipped-broken " Skipped (broken):") + (:skipped-disabled " Skipped (irrelevant):"))) + (format t " ~a / ~a~%" (enough-namestring (second fail)) (third fail))))) (when (> skipcount 0) @@ -82,18 +84,18 @@ (format t "All tests succeeded~%"))))) (defun pure-runner (files test-fun) - (format t "// Running pure tests (~a)~%" test-fun) - (let ((*package* (find-package :cl-user)) - (*failures* nil)) - (setup-cl-user) - (dolist (file files) - (when (accept-test-file file) + (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))) + (skip-file ()))) + (append-failures)))) (defun run-in-child-sbcl (load-forms forms) ;; We used to fork() for POSIX platforms, and use this for Windows. @@ -142,7 +144,7 @@ (t (format *error-output* "~&Unhandled ~a: ~a~%" (type-of condition) condition) - (sb-debug:backtrace))) + (sb-debug:print-backtrace))) (invoke-restart 'skip-file)))) ,test-code) (skip-file () @@ -151,11 +153,11 @@ (sb-ext:exit :code 104))))) (defun impure-runner (files test-fun) - (format t "// Running impure tests (~a)~%" test-fun) - (let ((*package* (find-package :cl-user))) - (setup-cl-user) - (dolist (file files) - (when (accept-test-file file) + (when files + (format t "// Running impure tests (~a)~%" test-fun) + (let ((*package* (find-package :cl-user))) + (setup-cl-user) + (dolist (file files) (force-output) (let ((exit-code (run-impure-in-child-sbcl file (funcall test-fun file)))) @@ -175,7 +177,7 @@ (t (format *error-output* "~&Unhandled ~a: ~a~%" (type-of condition) condition) - (sb-debug:backtrace))) + (sb-debug:print-backtrace))) (invoke-restart 'skip-file))) (defun append-failures (&optional (failures *failures*)) @@ -209,28 +211,29 @@ ;; What? No SB-POSIX:EXECV? `(let ((process (sb-ext:run-program "/bin/sh" (list (native-namestring ,file)) - :environment (test-util::test-env) :output *error-output*))) (let ((*failures* nil)) (test-util:report-test-status)) (sb-ext:exit :code (process-exit-code process)))) -(defun accept-test-file (file) - (if *accept-files* - (find (truename file) *accept-files* :test #'equalp) - t)) +(defun filter-test-files (wild-mask) + (if *explicit-test-files* + (loop for file in *explicit-test-files* + when (pathname-match-p file wild-mask) + collect file) + (directory wild-mask))) (defun pure-load-files () - (directory "*.pure.lisp")) + (filter-test-files "*.pure.lisp")) (defun pure-cload-files () - (directory "*.pure-cload.lisp")) + (filter-test-files "*.pure-cload.lisp")) (defun impure-load-files () - (directory "*.impure.lisp")) + (filter-test-files "*.impure.lisp")) (defun impure-cload-files () - (directory "*.impure-cload.lisp")) + (filter-test-files "*.impure-cload.lisp")) (defun sh-files () - (directory "*.test.sh")) + (filter-test-files "*.test.sh"))