source: trunk/abcl/test/lisp/abcl/package.lisp @ 13607

Last change on this file since 13607 was 13607, checked in by Mark Evenson, 10 years ago

Fixes for tests under SBCL.

Include the non-ABCL specific tests in bugs.lisp.

Allow SBCL to recompile the ABCL-TEST-LISP system by moving the
exporting of symbols into the DEFPACAKGE form.

  • Property svn:eol-style set to native
File size: 1.6 KB
Line 
1(defpackage #:abcl.test.lisp
2  (:use #:cl #:abcl-rt)
3  (:nicknames "ABCL-TEST-LISP" "ABCL-TEST")
4  (:export 
5   #:run 
6   #:do-matching #:run-matching
7   #:do-test 
8   #:do-tests
9   ;; previously in file-system-tests.lisp
10   #:pathnames-equal-p #:run-shell-command #:copy-file #:make-symbolic-link
11   #:touch #:make-temporary-directory #:delete-directory-and-files
12   ))
13(in-package #:abcl.test.lisp)
14
15(defparameter *abcl-test-directory* 
16  (if (find :asdf2 *features*)
17      (asdf:system-relative-pathname :abcl-test-lisp "test/lisp/abcl/")
18      (make-pathname :host (pathname-host *load-truename*)
19                     :device (pathname-device *load-truename*)
20                     :directory (pathname-directory *load-truename*))))
21
22(defun run ()
23  "Run the Lisp test suite for ABCL."
24  (let ((*default-pathname-defaults* *abcl-test-directory*))
25    (do-tests)))
26
27;;; XXX move this into test-utilities.lisp?
28(defvar *last-run-matching* "url-pathname")
29
30(defun do-matching (&optional (match *last-run-matching*))
31  "Run all tests in suite whose symbol contains MATCH in a case-insensitive manner."
32  (setf *last-run-matching* match)
33  (let* ((matching (string-upcase match))
34         (count 0))
35    (mapcar (lambda (entry) 
36              (if (search matching (symbol-name (abcl-rt::name entry)))
37                  (setf (abcl-rt::pend entry) t
38                        count (1+ count))
39                  (setf (abcl-rt::pend entry) nil)))
40            (rest abcl-rt::*entries*))
41    (format t "Performing ~A tests matching '~A'.~%" count matching)
42    (abcl-rt::do-entries t)))
43
44;;; Deprecated
45(setf (symbol-function 'run-matching) #'do-matching)
46
47   
48
49
50 
Note: See TracBrowser for help on using the repository browser.