-#+#.(cl:if (cl:find-package "ASDF") '(or) '(and))
-(require :asdf)
-
-#+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and))
(handler-bind (#+win32 (warning #'muffle-warning))
(require :sb-posix))
(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*))
(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)
(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.
(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))))
(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"))