package.lisp 1.72 KB
Newer Older
1
(defpackage #:abcl.test.lisp
2
  (:use #:cl #:abcl-rt)
3 4
  (:nicknames "ABCL-TEST-LISP" "ABCL-TEST")
  (:export 
5 6
   #:run 
   #:do-test 
7
   #:do-tests
8
   #:do-tests-matching
9 10 11
   ;; previously in file-system-tests.lisp
   #:pathnames-equal-p #:run-shell-command #:copy-file #:make-symbolic-link
   #:touch #:make-temporary-directory #:delete-directory-and-files
12
   ;;; Deprecated
13 14
   #:do-matching #:run-matching))

15 16
(in-package #:abcl.test.lisp)

17
(defparameter *abcl-test-directory* 
18
  (if (find :asdf2 *features*)
19
      (asdf:system-relative-pathname :abcl "test/lisp/abcl/")
20 21 22
      (make-pathname :host (pathname-host *load-truename*)
                     :device (pathname-device *load-truename*)
                     :directory (pathname-directory *load-truename*))))
23 24

(defun run ()
25
  "Run the Lisp test suite for ABCL."
26 27
  (let ((*default-pathname-defaults* *abcl-test-directory*))
    (do-tests)))
28

29
;;; XXX move this into test-utilities.lisp?
30 31
(defvar *last-run-matching* "url-pathname")

32
(defun do-tests-matching (&optional (match *last-run-matching*))
33
  "Run all tests in suite whose symbol contains MATCH in a case-insensitive manner."
34
  (setf *last-run-matching* match)
35
  (let* ((matching (string-upcase match))
36 37 38 39 40 41 42 43 44 45 46
         (count 0))
    (mapcar (lambda (entry) 
              (if (search matching (symbol-name (abcl-rt::name entry)))
                  (setf (abcl-rt::pend entry) t
                        count (1+ count))
                  (setf (abcl-rt::pend entry) nil)))
            (rest abcl-rt::*entries*))
    (format t "Performing ~A tests matching '~A'.~%" count matching)
    (abcl-rt::do-entries t)))

;;; Deprecated 
47 48
(setf (symbol-function 'run-matching) #'do-tests-matching)
(setf (symbol-function 'do-matching) #'do-tests-matching)
49

50
    
51

52

53