[armedbear-cvs] r13924 - in trunk/abcl: . test/lisp/ansi

mevenson at common-lisp.net mevenson at common-lisp.net
Fri May 4 09:14:25 UTC 2012


Author: mevenson
Date: Fri May  4 02:14:24 2012
New Revision: 13924

Log:
ansi-tests: DO-TESTS-MATCHING will run all case-insensitive matching tests.

An ASDF load of ANSI-INTERPRETED now loads the interpreted tests into
memory via an :around specialization.

Changes in ABCL.TEST.ANSI (aka ANSI-TESTS):

DO-TESTS-MATCHING implemented (cribbed from ABCL-TEST-LISP).

Refactored DEFPACKAGE forms out of ABCL-ANSI-TESTS code, creating
abcl-ansi.lisp to hold all other forms.

Import symbols from REGRESSION-TEST where it makes sense (list could
probably be larger; why not just use the package?)

Added:
   trunk/abcl/test/lisp/ansi/abcl-ansi.lisp
   trunk/abcl/test/lisp/ansi/packages.lisp
      - copied, changed from r13923, trunk/abcl/test/lisp/ansi/package.lisp
Deleted:
   trunk/abcl/test/lisp/ansi/package.lisp
Modified:
   trunk/abcl/abcl.asd

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	Wed May  2 04:56:59 2012	(r13923)
+++ trunk/abcl/abcl.asd	Fri May  4 02:14:24 2012	(r13924)
@@ -66,37 +66,44 @@
    "Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
    (funcall (intern (symbol-name 'run) :abcl.test.lisp)))
 
-;;; Test ABCL with the interpreted ANSI tests
-(defsystem :ansi-interpreted :version "1.1" 
-           :components
-           ((:module ansi-tests :pathname "test/lisp/ansi/" :components
-	       ((:file "package")
-                (:file "parse-ansi-errors" :depends-on ("package"))))))
+(defsystem :ansi-interpreted 
+  :version "1.2" 
+  :description "Test ABCL with the interpreted ANSI tests" :components 
+  ((:module ansi-tests :pathname "test/lisp/ansi/" :components
+            ((:file "packages")
+             (:file "abcl-ansi" :depends-on ("packages"))
+             (:file "parse-ansi-errors" :depends-on ("abcl-ansi"))))))
 (defmethod perform :before ((o test-op) (c (eql (find-system :ansi-interpreted))))
   (load-system  :ansi-interpreted))
+
+(defmethod perform :after ((o load-op) (c (eql (find-system :ansi-interpreted))))
+  (funcall (intern (symbol-name 'load-tests) :abcl.test.ansi)))
+
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-interpreted))))
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests nil))
 
-;;; Test ABCL with the compiled ANSI tests
-(defsystem :ansi-compiled :version "1.1" 
-           :components
+
+(defsystem :ansi-compiled :version "1.2" 
+           :description "Test ABCL with the compiled ANSI tests." :components 
            ((:module ansi-tests :pathname "test/lisp/ansi/" :components
-	       ((:file "package")
-                (:file "parse-ansi-errors" :depends-on ("package"))))))
+                     ((:file "packages")
+                      (:file "abcl-ansi" :depends-on ("packages"))
+                      (:file "parse-ansi-errors" :depends-on ("abcl-ansi"))))))
+
 (defmethod perform :before ((o test-op) (c (eql (find-system :ansi-compiled))))
   (load-system :ansi-compiled))
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-compiled))))
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests t))
 
-;;; Test ABCL with CL-BENCH 
-(defsystem :cl-bench :components
-           ((:module cl-bench-package :pathname "../cl-bench/"
-                    :components ((:file "defpackage")))
-            (:module cl-bench-wrapper :pathname "test/lisp/cl-bench/" 
-                     :depends-on (cl-bench-package) :components
-                     ((:file "wrapper")))))
+(defsystem :cl-bench 
+  :description "Test ABCL with CL-BENCH."
+  :components ((:module cl-bench-package :pathname "../cl-bench/"
+                        :components ((:file "defpackage")))
+               (:module cl-bench-wrapper :pathname "test/lisp/cl-bench/" 
+                        :depends-on (cl-bench-package) :components
+                        ((:file "wrapper")))))
 (defmethod perform :before ((o test-op) (c (eql (find-system :cl-bench))))
   (load-system :cl-bench))
 (defmethod perform ((o test-op) (c (eql (find-system :cl-bench))))

Added: trunk/abcl/test/lisp/ansi/abcl-ansi.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/abcl/test/lisp/ansi/abcl-ansi.lisp	Fri May  4 02:14:24 2012	(r13924)
@@ -0,0 +1,92 @@
+(in-package :abcl.test.ansi)
+
+(defparameter *ansi-tests-master-source-location*
+  "<svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests>")  
+
+(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)))))
+
+(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)))
+    (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))
+	  (time (load boot-file))
+	  (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")))))
+
+;;; XXX move this into test-utilities.lisp?
+(defvar *last-run-matching* "bit-vector")
+
+(defun do-tests-matching (&optional (match *last-run-matching*))
+  "Run all tests in suite whose symbol contains MATCH in a case-insensitive manner."
+  (setf *last-run-matching* match)
+  (let* ((matching (string-upcase match))
+         (count 0))
+    (mapcar (lambda (entry) 
+              (if (search matching (symbol-name (rt::name entry)))
+                  (setf (rt::pend entry) t
+                        count (1+ count))
+                  (setf (rt::pend entry) nil)))
+            (rest rt::*entries*))
+    (format t "Performing ~A tests matching '~A'.~%" count matching)
+    (rt::do-entries t)))

Copied and modified: trunk/abcl/test/lisp/ansi/packages.lisp (from r13923, trunk/abcl/test/lisp/ansi/package.lisp)
==============================================================================
--- trunk/abcl/test/lisp/ansi/package.lisp	Wed May  2 04:56:59 2012	(r13923, copy source)
+++ trunk/abcl/test/lisp/ansi/packages.lisp	Fri May  4 02:14:24 2012	(r13924)
@@ -2,87 +2,14 @@
   (:use :cl :cl-user)
   (:nicknames #:ansi-tests #:abcl-ansi-tests #:gcl-ansi)
   (:export #:run 
-	   #:verify-ansi-tests
+           #:verify-ansi-tests
 	   #:load-tests
 	   #:clean-tests
            #:full-report
-	   #:report #:parse))
+	   #:report #:parse)
+  (:import-from #:rt #:do-test #:do-test #:do-tests))
 
-(in-package :abcl.test.ansi)
 
-(defparameter *ansi-tests-master-source-location*
-  "<svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests>")  
-
-(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)))))
-
-(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)))
-    (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))
-	  (time (load boot-file))
-	  (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")))))
 
 		   
 	     




More information about the armedbear-cvs mailing list