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

[Mark Evenson]

Author: mevenson
Date: Tue Dec 22 11:07:07 2009
New Revision: 12301

Log:
Loading ABCL tests improved; renamed loading jar-file tests.

ASDF loading of ABCL-TEST-LISP improved to not need :FORCE argument.

JAR-FILE tests included as part of ABCL-TEST-LISP.


Added:
   trunk/abcl/test/lisp/abcl/jar-file.lisp
      - copied, changed from r12300, /trunk/abcl/test/lisp/abcl/load.lisp
Removed:
   trunk/abcl/test/lisp/abcl/load.lisp
Modified:
   trunk/abcl/abcl.asd
   trunk/abcl/test/lisp/abcl/package.lisp

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	(original)
+++ trunk/abcl/abcl.asd	Tue Dec 22 11:07:07 2009
@@ -7,7 +7,7 @@
 (in-package :abcl-asdf)
 
 ;;; Wrapper for all ABCL ASDF definitions.
-(defsystem :abcl :version "0.3.0")
+(defsystem :abcl :version "0.3.1")
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :abcl))))
   ;;; Additional test suite loads would go here.
@@ -19,15 +19,18 @@
 
 ;;; A collection of test suites for ABCL.
 (defsystem :test-abcl
-  :version "0.3"
+  :version "0.3.1"
   :depends-on (:ansi-compiled #+nil :abcl-tests))
 
-(defmethod perform :after ((o load-op) (c (eql (find-system :test-abcl))))
+(defmethod perform :after ((o load-op) (c (eql (find-system :abcl))))
   #+nil (asdf:oos 'asdf:test-op :cl-bench :force t)
   (operate 'load-op :abcl-test-lisp :force t)
   (operate 'load-op :ansi-compiled :force t)
   (operate 'load-op :ansi-interpreted :force t))
 
+(defmethod perform :before ((o load-op) (c t))
+  (warn "ASDF load-op class is ~A" c))
+
 (defsystem :ansi-test :version "1.0" :components
      ;;; GCL ANSI test suite.
      ((:module ansi-tests :pathname "test/lisp/ansi/" :components
@@ -36,27 +39,35 @@
 (defsystem :ansi-interpreted :version "1.0" :depends-on (ansi-test))
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-interpreted))))
    "Invoke tests with:  (asdf:oos 'asdf:test-op :ansi-interpreted :force t)."
-   ;;; FIXME needs ASDF:OOS to be invoked with :FORCE t
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests nil))
+(defmethod perform :before ((o test-op) (c (eql (find-system
+                                                 :ansi-interpreted))))
+  (operate 'load-op :ansi-interpreted :force t))
 
 (defsystem :ansi-compiled :version "1.0" :depends-on (ansi-test))
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-compiled))))
   "Invoke tests with:  (asdf:oos 'asdf:test-op :abcl-compiled :force t)."
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests t))
+(defmethod perform :before ((o test-op) (c (eql (find-system
+                                                 :ansi-compiled))))
+  (operate 'load-op :ansi-compiled :force t))
 
-(defsystem :abcl-test-lisp :version "1.0" :components
+(defsystem :abcl-test-lisp :version "1.1" :components
 	   ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components
 		     ((:file "rt-package") (:file "rt")))
 	    (:module package  :depends-on (abcl-rt)
 		     :pathname "test/lisp/abcl/" :components
 		     ((:file "package")))))
 
+(defmethod perform :before ((o test-op) (c (eql (find-system
+                                                 :abcl-test-lisp))))
+  (operate 'load-op :abcl-test-lisp :force t))
+
 (defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
-   "Invoke tests with:  (asdf:oos 'asdf:test-op :abcl-test-lisp :force t)."
-   ;;; FIXME needs ASDF:OOS to be invoked with :FORCE t
-   (funcall (intern (symbol-name 'run) :abcl.test.lisp)))
+   "Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
+   (funcall (intern (symbol-name 'run) :abcl-test)))
  
 ;;; Build ABCL from a Lisp.
 ;;; aka the "Lisp-hosted build system"

Copied: trunk/abcl/test/lisp/abcl/jar-file.lisp (from r12300, /trunk/abcl/test/lisp/abcl/load.lisp)
==============================================================================
--- /trunk/abcl/test/lisp/abcl/load.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/jar-file.lisp	Tue Dec 22 11:07:07 2009
@@ -5,55 +5,79 @@
 (defun load-init ()
   (let* ((*default-pathname-defaults* *this-directory*)
          (asdf::*verbose-out* *standard-output*)
-         (package-command (format nil "sh ~A" (merge-pathnames "package-load.sh"))))
+         (package-command (format nil "cd ~A; sh ~A" 
+                                  *this-directory*
+                                  (merge-pathnames "package-load.sh"))))
     (compile-file "foo.lisp")
     (compile-file "bar.lisp")
     (compile-file "eek.lisp")
-    (asdf:run-shell-command package-command)))
+    (asdf:run-shell-command package-command))
+  (setf *jar-file-init* t))
 
-(load-init)
+(defvar *jar-file-init* nil)
 
-(deftest load.1
-    (let ((*default-pathname-defaults* *this-directory*))
-      (load "foo"))
+
+(defmacro with-jar-file-init (&rest body)
+  `(let ((*default-pathname-defaults* *this-directory*))
+     (progn
+       (unless *jar-file-init*
+         (load-init))
+       , at body)))
+  
+
+(deftest jar-file-load.1
+    (with-jar-file-init
+        (load "foo"))
   t)
 
-(deftest load.2
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.2
+    (with-jar-file-init
       (load "foo.lisp"))
   t)
 
-(deftest load.3
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.3
+    (with-jar-file-init
       (load "foo.abcl"))
   t)
 
-(deftest load.4
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.4
+    (with-jar-file-init
       (load "jar:file:baz.jar!/foo"))
   t)
 
-(deftest load.6
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.6
+    (with-jar-file-init
       (load "jar:file:baz.jar!/bar"))
   t)
 
-(deftest load.7
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.7
+    (with-jar-file-init
       (load "jar:file:baz.jar!/bar.abcl"))
   t)
 
-(deftest load.8
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.8
+    (with-jar-file-init
       (load "jar:file:baz.jar!/eek"))
   t)
 
-(deftest load.9
-    (let ((*default-pathname-defaults* *this-directory*))
+(deftest jar-file-load.9
+    (with-jar-file-init
       (load "jar:file:baz.jar!/eek.lisp"))
   t)
 
 
+(deftest jar-file-probe-file.1
+    (with-jar-file-init
+        (probe-file "jar:file:baz.jar!/eek.lisp"))
+  #p"jar:file:baz.jar!/eek.lisp")
+
+
+(deftest jar-file-merge-pathnames.1
+    (merge-pathnames 
+     "!/foo" #p"jar:file:baz.jar")
+  #p"jar:file:baz.jar!/foo")
+
+
 
 
 

Modified: trunk/abcl/test/lisp/abcl/package.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/package.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/package.lisp	Tue Dec 22 11:07:07 2009
@@ -23,6 +23,9 @@
     (load "math-tests.lisp")
     (load "misc-tests.lisp")
 
+    (when (find :unix *features*)
+      (load "jar-file.lisp"))
+
     (do-tests)))
 
 	
\ No newline at end of file