source: trunk/abcl/test/lisp/ansi/abcl-ansi.lisp @ 14249

Last change on this file since 14249 was 14249, checked in by Mark Evenson, 8 years ago

ansi-tests: always clean out the intermediate artifacts when running ANSI tests.

Now output the removed artifacts to *STANDARD-OUTPUT*.

File size: 3.5 KB
Line 
1(in-package :abcl.test.ansi)
2
3(defparameter *ansi-tests-master-source-location*
4  "<svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests>") 
5
6(defparameter *ansi-tests-directory*
7  (if (find :asdf2 *features*)
8      (asdf:system-relative-pathname :ansi-compiled "../ansi-tests/")
9      (merge-pathnames #p"../ansi-tests/"
10           (asdf:component-pathname 
11      (asdf:find-system :ansi-compiled)))))
12
13(defun run (&key (compile-tests nil)) 
14  "Run the ANSI-TESTS suite, to be found in *ANSI-TESTS-DIRECTORY*.
15Possibly running the compiled version of the tests if COMPILE-TESTS is non-NIL."
16  (verify-ansi-tests)
17  (mapcar (lambda (result)
18            (when (second result)
19              (format t "Removed ~A.~&" (first result))))
20          (clean-tests))
21  (let* ((ansi-tests-directory 
22    *ansi-tests-directory*)
23   (boot-file 
24    (if compile-tests "compileit.lsp" "doit.lsp"))
25   (message 
26    (format nil "Invocation of '~A' in ~A" 
27      boot-file ansi-tests-directory)))
28    (progv 
29  '(*default-pathname-defaults*) 
30  `(,(merge-pathnames *ansi-tests-directory* 
31          *default-pathname-defaults*))
32    (format t "--->  ~A begins.~%" message)
33    (format t "Invoking ABCL hosted on ~A ~A.~%" 
34      (software-type) (software-version))
35    (time (load boot-file))
36    (format t "<--- ~A ends.~%" message))))
37
38(defun verify-ansi-tests () 
39  (unless 
40      (probe-file *ansi-tests-directory*)
41    (error 'file-error
42     "Failed to find the GCL ANSI tests in '~A'. Please
43locally obtain ~A, and place it in a sibling directory to the ABCL source named '../ansi-tests/'"
44       *ansi-tests-directory*
45       *ansi-tests-master-source-location*)))
46
47(defvar *ansi-tests-loaded-p* nil)
48(defun load-tests ()
49  "Load the ANSI tests but do not execute them."
50  (verify-ansi-tests)
51  (let ((*default-pathname-defaults* *ansi-tests-directory*)
52  (package *package*))
53    (setf *package* (find-package :cl-user))
54    (load "gclload1.lsp")
55    (load "gclload2.lsp")
56    (setf *package* package))
57  (setf *ansi-tests-loaded-p* t))
58 
59(defun clean-tests ()
60  "Do what 'make clean' would do from the GCL ANSI tests,"
61  ;; so we don't have to hunt for 'make' in the PATH on win32.
62  (verify-ansi-tests)
63
64  (mapcar (lambda (p)
65            (when (probe-file p)
66              (list p (delete-file p))))
67    (append (directory (format nil "~A/*.cls" *ansi-tests-directory*))
68      (directory (format nil "~A/*.abcl" *ansi-tests-directory*))
69      (directory (format nil "~A/scratch/*" *ansi-tests-directory*))
70      (mapcar (lambda(x) 
71          (format nil "~A/~A" *ansi-tests-directory* x))
72        '("scratch/"
73          "scratch.txt" "foo.txt" "foo.lsp"
74          "foo.dat" 
75          "tmp.txt" "tmp.dat" "tmp2.dat"
76          "temp.dat" "out.class" 
77          "file-that-was-renamed.txt"
78          "compile-file-test-lp.lsp"
79          "compile-file-test-lp.out" 
80          "ldtest.lsp")))))
81
82;;; XXX move this into test-utilities.lisp?
83(defvar *last-run-matching* "bit-vector")
84
85(defun do-tests-matching (&optional (match *last-run-matching*))
86  "Run all tests in suite whose symbol contains MATCH in a case-insensitive manner."
87  (setf *last-run-matching* match)
88  (let* ((matching (string-upcase match))
89         (count 0)
90         (*default-pathname-defaults* *ansi-tests-directory*))
91    (mapcar (lambda (entry) 
92              (if (search matching (symbol-name (rt::name entry)))
93                  (setf (rt::pend entry) t
94                        count (1+ count))
95                  (setf (rt::pend entry) nil)))
96            (rest rt::*entries*))
97    (format t "Performing ~A tests matching '~A'.~%" count matching)
98    (rt::do-entries t)))
Note: See TracBrowser for help on using the repository browser.