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

Last change on this file since 13925 was 13925, checked in by Mark Evenson, 9 years ago

ansi-tests: Fix ANSI-RT load definition.

A bit of a circular dance here to be able to use the ANSI-TESTS via
ASDF. In order to define functions like
ABCL.TEST.ANSI:DO-TESTS-MATCHING we need to have loaded the
REGRESSION-TEST package included with the ANSI-TESTS, so we can no
longer use the value of the ABCL.TEST.ANSI:*ANSI-TESTS-DIRECTORY*. We
now do this via a relative pathname of the form '../ansi-tests/' to
the location of 'abcl.asd' file, whereas our api previously suggested
that one could set the contents of
ABCL.TEST.ANSI:*ANSI-TESTS-DIRECTORY* to an arbitrary pathname. This
fixes the location of the ANSI-TESTS on the filesystem to be a sibling
directory named 'ansi-tests' to the truename of the directory
containing 'abcl.asd'.

I tried to add some sort of :before method to either the ASDF:LOAD-OP
or the ASDF:COMPILE-OP for the ANSI-RT definition, but assuming that
the source named in an system definition exists locally seems too
baked into ASDF2 to be cleanly intercepted.

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