[armedbear-cvs] r13297 - trunk/abcl/test/lisp/ansi

[mevenson at common-lisp.net]

Author: mevenson
Date: Wed May 25 07:32:07 2011
New Revision: 13297

Log:
Add LOAD-TESTS to load ANSI tests without actually executing them.

Refactor code into separate CLEAN-TEST and VERIFY-ANSI-TEST which
facilitates interactive use of the package.

Modified:
   trunk/abcl/test/lisp/ansi/package.lisp

Modified: trunk/abcl/test/lisp/ansi/package.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/package.lisp	Wed May 25 07:31:59 2011	(r13296)
+++ trunk/abcl/test/lisp/ansi/package.lisp	Wed May 25 07:32:07 2011	(r13297)
@@ -1,7 +1,11 @@
-(defpackage :abcl.test.ansi
-  (:use :cl :asdf)
-  (:nicknames "ansi-tests" "abcl-ansi-tests" "gcl-ansi")
-  (:export :run :report :parse))
+(defpackage #:abcl.test.ansi
+  (:use :cl :cl-user)
+  (:nicknames #:ansi-tests #:abcl-ansi-tests #:gcl-ansi)
+  (:export #:run 
+	   #:verify-ansi-tests
+	   #:load-tests
+	   #:clean-tests
+	   #:report #:parse))
 
 (in-package :abcl.test.ansi)
 
@@ -10,55 +14,74 @@
 
 (defparameter *ansi-tests-directory*
   (if (find :asdf2 *features*)
-      (asdf:system-relative-pathname 
-       :ansi-compiled "../ansi-tests/")
-      (merge-pathnames
-       #p"../ansi-tests/"
-       (asdf:component-pathname (asdf:find-system :ansi-compiled)))))
+      (asdf:system-relative-pathname :ansi-compiled "../ansi-tests/")
+      (merge-pathnames #p"../ansi-tests/"
+		       (asdf:component-pathname 
+			(asdf:find-system :ansi-compiled)))))
 
 (defun run (&key (compile-tests nil)) 
   "Run the ANSI-TESTS suite, to be found in *ANSI-TESTS-DIRECTORY*.
 Possibly running the compiled version of the tests if COMPILE-TESTS is non-NIL."
+  (verify-ansi-tests)
   (let* ((ansi-tests-directory 
 	  *ansi-tests-directory*)
 	 (boot-file 
 	  (if compile-tests "compileit.lsp" "doit.lsp"))
 	 (message 
-	  (format nil "Invocation of '~A' in ~A" boot-file ansi-tests-directory)))
-    (handler-case 
-	(progv 
-	    '(*default-pathname-defaults*) 
-	    `(,(merge-pathnames *ansi-tests-directory* *default-pathname-defaults*))
+	  (format nil "Invocation of '~A' in ~A" 
+		  boot-file ansi-tests-directory)))
+    (progv 
+	'(*default-pathname-defaults*) 
+	`(,(merge-pathnames *ansi-tests-directory* 
+			    *default-pathname-defaults*))
 	  (format t "--->  ~A begins.~%" message)
 	  (format t "Invoking ABCL hosted on ~A ~A.~%" 
 		  (software-type) (software-version))
-          ;; Do what 'make clean' would do from the GCL ANSI tests,
-          ;; so we don't have to hunt for 'make' on win32.
-          (mapcar #'delete-file
-                  (append (directory (format nil "~A/*.cls" *default-pathname-defaults*))
-                          (directory (format nil "~A/*.abcl" *default-pathname-defaults*))
-                          (directory (format nil "~A/scratch/*" *default-pathname-defaults*))
-                          (mapcar (lambda(x) (format nil "~A/~A" *default-pathname-defaults* x))
-                                  '("scratch/"
-                                    "scratch.txt" "foo.txt" "foo.lsp"
-                                    "foo.dat" 
-                                    "tmp.txt" "tmp.dat" "tmp2.dat"
-                                    "temp.dat" "out.class" 
-                                    "file-that-was-renamed.txt"
-                                    "compile-file-test-lp.lsp"
-                                    "compile-file-test-lp.out" 
-                                    "ldtest.lsp"))))
 	  (time (load boot-file))
-	  (format t "<--- ~A ends.~%" message))
-      (file-error (e)
-		(error 
-		 (format nil
-			 "Failed to find the GCL ANSI tests in '~A'.
-Because ~A.
-To resolve, please locally obtain ~A, 
-and set the value of *ANSI-TESTS-DIRECTORY* to that location."
-		 ansi-tests-directory e 
-		 *ansi-tests-master-source-location*))))))
+	  (format t "<--- ~A ends.~%" message))))
+
+(defun verify-ansi-tests () 
+  (unless 
+      (probe-file *ansi-tests-directory*)
+    (error 'file-error
+	   "Failed to find the GCL ANSI tests in '~A'. Please
+locally obtain ~A, and set the value of *ANSI-TESTS-DIRECTORY* to that
+location."  
+	     *ansi-tests-directory*
+	     *ansi-tests-master-source-location*)))
+
+(defvar *ansi-tests-loaded-p* nil)
+(defun load-tests ()
+  "Load the ANSI tests but do not execute them."
+  (verify-ansi-tests)
+  (let ((*default-pathname-defaults* *ansi-tests-directory*)
+	(package *package*))
+    (setf *package* (find-package :cl-user))
+    (load "gclload1.lsp")
+    (load "gclload2.lsp")
+    (setf *package* package))
+  (setf *ansi-tests-loaded-p* t))
+  
+(defun clean-tests ()
+  "Do what 'make clean' would do from the GCL ANSI tests,"
+  ;; so we don't have to hunt for 'make' in the PATH on win32.
+  (verify-ansi-tests)
+
+  (mapcar #'delete-file
+	  (append (directory (format nil "~A/*.cls" *ansi-tests-directory*))
+		  (directory (format nil "~A/*.abcl" *ansi-tests-directory*))
+		  (directory (format nil "~A/scratch/*" *ansi-tests-directory*))
+		  (mapcar (lambda(x) 
+			    (format nil "~A/~A" *ansi-tests-directory* x))
+			  '("scratch/"
+			    "scratch.txt" "foo.txt" "foo.lsp"
+			    "foo.dat" 
+			    "tmp.txt" "tmp.dat" "tmp2.dat"
+			    "temp.dat" "out.class" 
+			    "file-that-was-renamed.txt"
+			    "compile-file-test-lp.lsp"
+			    "compile-file-test-lp.out" 
+			    "ldtest.lsp")))))