[armedbear-cvs] r12402 - in trunk/abcl: . src/org/armedbear/lisp test/lisp/abcl test/src/org/armedbear/lisp
Mark Evenson
mevenson at common-lisp.net
Tue Jan 26 11:15:51 UTC 2010
Author: mevenson
Date: Tue Jan 26 06:15:48 2010
New Revision: 12402
Log:
Move abcl-test-lisp to ASDF packaging.
Change to ASDF packaging of abcl-test-lisp. Remove ASDF system
'abcl-tests' as ASDF systems without components don't carry
dependencies transitively. Remove unneed :BEFORE load of
abcl-test-lisp. Renamed conflicting tests now that they are loaded via
ASDF.
Implement ability to run tests matching a string. Export
ABCL.TEST.LISP::RUN-MATCHING as external symbol.
Added 'test/lisp/abcl/math-tests.lisp' back to ABCL.TEST.LISP, fixing
errors that prevented it from working.
Fix bug with directories specified to three-arg form of SYS:ZIP. JAR
files always use '/' to name hierarchial entries. Allow of a top
directory for creating hierarchially ZIPs: for arguments like
"pathname pathnames &optional topdir" all pathnames will be
interpolated relative to topdir.
Contains the version of jar-file tests corresponding to PATHNAME,
TRUENAME, and PROBE-FILE. The tests for jar-file will currently fail
as it needs the implementation of SYS:UNZIP which in turn depends on
the new version of Pathname which should follow shortly in a separate
commit.
jar-file initilization rewritten in Lisp, so it works under Windows.
Java tests for Pathname and Stream.
Help my dyslexic brain by renaming
*abcl-{lisp-test,test,lisp}-directory* to *abcl-test-directory*.
Refinement of jar-file tests. Correct all JAR-FILE.PATHNAME.* tests.
JAR-FILE tests use the cross-platform form of COPY-FILE. Renamed test,
using WITH-JAR-FILE-INIT macro.
Added:
trunk/abcl/test/src/org/armedbear/lisp/PathnameTest.java
trunk/abcl/test/src/org/armedbear/lisp/StreamTest.java
Removed:
trunk/abcl/test/lisp/abcl/package-load.sh
Modified:
trunk/abcl/abcl.asd
trunk/abcl/src/org/armedbear/lisp/zip.java
trunk/abcl/test/lisp/abcl/condition-tests.lisp
trunk/abcl/test/lisp/abcl/file-system-tests.lisp
trunk/abcl/test/lisp/abcl/jar-file.lisp
trunk/abcl/test/lisp/abcl/math-tests.lisp
trunk/abcl/test/lisp/abcl/misc-tests.lisp
trunk/abcl/test/lisp/abcl/mop-tests.lisp
trunk/abcl/test/lisp/abcl/package.lisp
trunk/abcl/test/lisp/abcl/test-utilities.lisp
Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd (original)
+++ trunk/abcl/abcl.asd Tue Jan 26 06:15:48 2010
@@ -10,7 +10,6 @@
(defsystem :abcl :version "0.5.0")
(defmethod perform :after ((o load-op) (c (eql (find-system :abcl))))
- (operate 'load-op :abcl-tests :force t)
(operate 'load-op :abcl-test-lisp :force t)
(operate 'load-op :cl-bench :force t)
(operate 'load-op :ansi-compiled :force t)
@@ -20,38 +19,30 @@
(defmethod perform ((o test-op) (c (eql (find-system :abcl))))
(operate 'test-op :abcl-tests :force t))
-;;; A collection of test suites for ABCL.
-(defsystem :abcl-tests
- :version "2.0"
- :depends-on (:abcl-test-lisp
- :ansi-compiled :ansi-interpreted
- :cl-bench))
-
-(defmethod perfom :before ((o test-op (c (eql find-system :abcl-tests))))
- (operate 'load-op :abcl-test-lisp)
- (operate 'load-op :ansi-compiled)
- (operate 'load-op :cl-bench))
-
-;;; Run via (asdf:operate 'asdf:test-op :abcl-tests :force t)
-(defmethod perform ((o test-op) (c (eql (find-system :abcl-tests))))
- ;; Additional test suite invocations would go here.
- (operate 'test-op :abcl-test-lisp)
- (operate 'test-op :ansi-compiled)
- (operate 'test-op :cl-bench))
-
;;; Test ABCL with the Lisp unit tests collected in "test/lisp/abcl"
(defsystem :abcl-test-lisp :version "1.1" :components
- ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components
- ((:file "rt-package") (:file "rt")))
+ ((:module abcl-rt
+ :pathname "test/lisp/abcl/" :serial t :components
+ ((:file "rt-package") (:file "rt")
+ (:file "test-utilities")))
(: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))
+ ((:file "package")))
+ (:module test :depends-on (package)
+ :pathname "test/lisp/abcl/" :components
+ ((:file "compiler-tests")
+ (:file "condition-tests")
+ (:file "mop-tests-setup")
+ (:file "mop-tests" :depends-on ("mop-tests-setup"))
+ (:file "file-system-tests")
+ (:file "jar-file")
+ (:file "math-tests")
+ (:file "misc-tests")
+ (:file "pathname-tests")))))
+
(defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
"Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
- (funcall (intern (symbol-name 'run) :abcl-test)))
+ (funcall (intern (symbol-name 'run) :abcl.test.lisp)))
;;; Test ABCL with the interpreted ANSI tests
(defsystem :ansi-interpreted :version "1.0.1"
Modified: trunk/abcl/src/org/armedbear/lisp/zip.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/zip.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/zip.java Tue Jan 26 06:15:48 2010
@@ -39,6 +39,8 @@
import java.io.FileInputStream;
import java.io.FileOutputStream;
import java.io.IOException;
+import java.util.HashSet;
+import java.util.Set;
import java.util.zip.ZipEntry;
import java.util.zip.ZipOutputStream;
@@ -47,7 +49,7 @@
{
private zip()
{
- super("zip", PACKAGE_SYS, true, "pathname pathnames");
+ super("zip", PACKAGE_SYS, true, "pathname pathnames &optional topdir");
}
@Override
@@ -94,5 +96,74 @@
return zipfilePathname;
}
+ @Override
+ public LispObject execute(LispObject first, LispObject second, LispObject third)
+ {
+ Pathname zipfilePathname = coerceToPathname(first);
+ byte[] buffer = new byte[4096];
+ try {
+ String zipfileNamestring = zipfilePathname.getNamestring();
+ if (zipfileNamestring == null)
+ return error(new SimpleError("Pathname has no namestring: " +
+ zipfilePathname.writeToString()));
+ ZipOutputStream out =
+ new ZipOutputStream(new FileOutputStream(zipfileNamestring));
+ Pathname root = (Pathname)coerceToPathname(third);
+ String rootPath = root.getDirectoryNamestring();
+ int rootPathLength = rootPath.length();
+ Set<String> directories = new HashSet<String>();
+ LispObject list = second;
+ while (list != NIL) {
+ Pathname pathname = coerceToPathname(list.car());
+ String namestring = pathname.getNamestring();
+ if (namestring == null) {
+ // Clean up before signalling error.
+ out.close();
+ File zipfile = new File(zipfileNamestring);
+ zipfile.delete();
+ return error(new SimpleError("Pathname has no namestring: " +
+ pathname.writeToString()));
+ }
+ String directory = "";
+ String dir = pathname.getDirectoryNamestring();
+ if (dir.length() > rootPathLength) {
+ String d = dir.substring(rootPathLength);
+ int i = 0;
+ int j;
+ while ((j = d.indexOf(File.separator, i)) != -1) {
+ i = j + 1;
+ directory = d.substring(0, j).replace(File.separatorChar, '/') + "/";
+ if (!directories.contains(directory)) {
+ directories.add(directory);
+ ZipEntry entry = new ZipEntry(directory);
+ out.putNextEntry(entry);
+ out.closeEntry();
+ }
+ }
+ }
+ File file = new File(namestring);
+ if (file.isDirectory()) {
+ list = list.cdr();
+ continue;
+ }
+ FileInputStream in = new FileInputStream(file);
+ ZipEntry entry = new ZipEntry(directory + file.getName());
+ out.putNextEntry(entry);
+ int n;
+ while ((n = in.read(buffer)) > 0)
+ out.write(buffer, 0, n);
+ out.closeEntry();
+ in.close();
+ list = list.cdr();
+ }
+ out.close();
+ }
+ catch (IOException e) {
+ return error(new LispError(e.getMessage()));
+ }
+ return zipfilePathname;
+ }
+
+
private static final Primitive zip = new zip();
}
Modified: trunk/abcl/test/lisp/abcl/condition-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/condition-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/condition-tests.lisp Tue Jan 26 06:15:48 2010
@@ -16,8 +16,6 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-(load (merge-pathnames "test-utilities.lisp" *load-truename*))
-
(in-package #:abcl.test.lisp)
(defun filter (string)
Modified: trunk/abcl/test/lisp/abcl/file-system-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/file-system-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/file-system-tests.lisp Tue Jan 26 06:15:48 2010
@@ -33,12 +33,6 @@
:device (pathname-device *load-truename*)
:directory (pathname-directory *load-truename*)))
-(defmacro signals-error (form error-name)
- `(locally (declare (optimize safety))
- (handler-case ,form
- (error (c) (typep c ,error-name))
- (:no-error (&rest ignored) (declare (ignore ignored)) nil))))
-
(defun pathnames-equal-p (pathname1 pathname2)
#-(or allegro clisp cmu lispworks)
(equal pathname1 pathname2)
@@ -425,7 +419,7 @@
;; Allegro's version component is :UNSPECIFIC.
(pushnew 'user-homedir-pathname.1 *expected-failures*)
-(deftest directory-namestring.1
+(deftest file-system.directory-namestring.1
(let ((pathname (user-homedir-pathname)))
(equal (namestring pathname) (directory-namestring pathname)))
#-windows
@@ -434,15 +428,15 @@
;; The drive prefix ("C:\\") is not part of the directory namestring.
nil)
#+clisp
-(pushnew 'directory-namestring.1 *expected-failures*)
+(pushnew 'file-system.directory-namestring.1 *expected-failures*)
-(deftest directory-namestring.2
+(deftest file.system.directory-namestring.2
(let ((pathname (user-homedir-pathname)))
(equal (directory-namestring pathname)
(namestring (make-pathname :directory (pathname-directory pathname)))))
t)
#+clisp
-(pushnew 'directory-namestring.2 *expected-failures*)
+(pushnew 'file-system.directory-namestring.2 *expected-failures*)
(deftest ensure-directories-exist.1
(let* ((tmp (make-temporary-filename *this-directory*))
Modified: trunk/abcl/test/lisp/abcl/jar-file.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/jar-file.lisp (original)
+++ trunk/abcl/test/lisp/abcl/jar-file.lisp Tue Jan 26 06:15:48 2010
@@ -1,88 +1,277 @@
(in-package #:abcl.test.lisp)
-#-:unix (error "Load test setup currently needs UNIX shell script support.")
+(defvar *jar-file-init* nil)
-(defun load-init ()
- (let* ((*default-pathname-defaults* *this-directory*)
- (asdf::*verbose-out* *standard-output*)
- (package-command (format nil "cd ~A; sh ~A"
- *this-directory*
- (merge-pathnames "package-load.sh"))))
+;;; From CL-FAD
+(defvar *stream-buffer-size* 8192)
+(defun cl-fad-copy-stream (from to &optional (checkp t))
+ "Copies into TO \(a stream) from FROM \(also a stream) until the end
+of FROM is reached, in blocks of *stream-buffer-size*. The streams
+should have the same element type. If CHECKP is true, the streams are
+checked for compatibility of their types."
+ (when checkp
+ (unless (subtypep (stream-element-type to) (stream-element-type from))
+ (error "Incompatible streams ~A and ~A." from to)))
+ (let ((buf (make-array *stream-buffer-size*
+ :element-type (stream-element-type from))))
+ (loop
+ (let ((pos (read-sequence buf from)))
+ (when (zerop pos) (return))
+ (write-sequence buf to :end pos))))
+ (values))
+
+(defun cl-fad-copy-file (from to &key overwrite)
+ "Copies the file designated by the non-wild pathname designator FROM
+to the file designated by the non-wild pathname designator TO. If
+OVERWRITE is true overwrites the file designtated by TO if it exists."
+ (let ((element-type '(unsigned-byte 8)))
+ (with-open-file (in from :element-type element-type)
+ (with-open-file (out to :element-type element-type
+ :direction :output
+ :if-exists (if overwrite
+ :supersede :error))
+ (cl-fad-copy-stream in out))))
+ (values))
+
+(defun jar-file-init ()
+ (let* ((*default-pathname-defaults* *abcl-test-directory*)
+ (asdf::*verbose-out* *standard-output*))
(compile-file "foo.lisp")
(compile-file "bar.lisp")
(compile-file "eek.lisp")
- (asdf:run-shell-command package-command))
+ (let* ((dir (merge-pathnames "tmp/" *abcl-test-directory*))
+ (sub (merge-pathnames "a/b/" dir)))
+ (when (probe-directory dir)
+ (delete-directory-and-files dir))
+ (ensure-directories-exist sub)
+ (sys:unzip (merge-pathnames "foo.abcl")
+ dir)
+ (sys:unzip (merge-pathnames "foo.abcl")
+ sub)
+ (cl-fad-copy-file (merge-pathnames "bar.abcl")
+ (merge-pathnames "bar.abcl" dir))
+ (cl-fad-copy-file (merge-pathnames "bar.abcl")
+ (merge-pathnames "bar.abcl" sub))
+ (cl-fad-copy-file (merge-pathnames "eek.lisp")
+ (merge-pathnames "eek.lisp" dir))
+ (cl-fad-copy-file (merge-pathnames "eek.lisp")
+ (merge-pathnames "eek.lisp" sub))
+ (sys:zip (merge-pathnames "baz.jar")
+ (append
+ (directory (merge-pathnames "*" dir))
+ (directory (merge-pathnames "*" sub)))
+ dir)
+ (delete-directory-and-files dir)))
(setf *jar-file-init* t))
-(defvar *jar-file-init* nil)
-
(defmacro with-jar-file-init (&rest body)
- `(let ((*default-pathname-defaults* *this-directory*))
+ `(let ((*default-pathname-defaults* *abcl-test-directory*))
(progn
(unless *jar-file-init*
- (load-init))
+ (jar-file-init))
, at body)))
-
-(deftest jar-file-load.1
+#+nil
+(defmacro with-jar-file-init (&rest body)
+ `(progv '(*default-pathname-defaults*) '(,*abcl-test-directory*)
+ (unless *jar-file-init*
+ (load-init))
+ , at body))
+
+(deftest jar-file.load.1
(with-jar-file-init
- (load "foo"))
+ (load "jar:file:baz.jar!/foo"))
t)
-(deftest jar-file-load.2
+(deftest jar-file.load.2
(with-jar-file-init
- (load "foo.lisp"))
+ (load "jar:file:baz.jar!/bar"))
t)
-(deftest jar-file-load.3
+(deftest jar-file.load.3
(with-jar-file-init
- (load "foo.abcl"))
+ (load "jar:file:baz.jar!/bar.abcl"))
t)
-(deftest jar-file-load.4
+(deftest jar-file.load.4
(with-jar-file-init
- (load "jar:file:baz.jar!/foo"))
+ (load "jar:file:baz.jar!/eek"))
t)
-(deftest jar-file-load.6
+(deftest jar-file.load.5
(with-jar-file-init
- (load "jar:file:baz.jar!/bar"))
+ (load "jar:file:baz.jar!/eek.lisp"))
t)
-(deftest jar-file-load.7
+(deftest jar-file.load.6
(with-jar-file-init
- (load "jar:file:baz.jar!/bar.abcl"))
+ (load "jar:file:baz.jar!/a/b/foo"))
t)
-(deftest jar-file-load.8
+(deftest jar-file.load.7
(with-jar-file-init
- (load "jar:file:baz.jar!/eek"))
+ (load "jar:file:baz.jar!/a/b/bar"))
t)
-(deftest jar-file-load.9
+(deftest jar-file.load.8
(with-jar-file-init
- (load "jar:file:baz.jar!/eek.lisp"))
+ (load "jar:file:baz.jar!/a/b/bar.abcl"))
+ t)
+
+(deftest jar-file.load.9
+ (with-jar-file-init
+ (load "jar:file:baz.jar!/a/b/eek"))
t)
+(deftest jar-file.load.10
+ (with-jar-file-init
+ (load "jar:file:baz.jar!/a/b/eek.lisp"))
+ t)
-(deftest jar-file-probe-file.1
+(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") ; WRONG: PROBE-FILE should return
- ; TRUENAME on existence.
+ #p#.(format nil "jar:file:~A/baz.jar!/eek.lisp"
+ (namestring *abcl-test-directory*)))
+(deftest jar-file.probe-file.2
+ (with-jar-file-init
+ (probe-file "jar:file:baz.jar!/a/b/bar.abcl"))
+ #p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl"
+ (namestring *abcl-test-directory*)))
+
+(deftest jar-file.probe-file.3
+ (with-jar-file-init
+ (probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._"))
+ #p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
+ (namestring *abcl-test-directory*)))
+
+(deftest jar-file.probe-file.4
+ (with-jar-file-init
+ (probe-file "jar:file:baz.jar!/a/b"))
+ nil)
-(deftest jar-file-merge-pathnames.1
+(deftest jar-file.probe-file.5
+ (with-jar-file-init
+ (probe-file "jar:file:baz.jar!/a/b/"))
+ #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
+ (namestring *abcl-test-directory*)))
+
+(deftest jar-file.merge-pathnames.1
+ (merge-pathnames
+ "/bar.abcl" #p"jar:file:baz.jar!/foo")
+ #p"jar:file:baz.jar!/bar.abcl")
+
+(deftest jar-file.merge-pathnames.2
(merge-pathnames
- "!/foo" #p"jar:file:baz.jar")
+ "/bar.abcl" #p"jar:file:baz.jar!/foo/")
+ #p"jar:file:baz.jar!/foo/bar.abcl")
+
+(deftest jar-file.merge-pathnames.3
+ (merge-pathnames
+ "jar:file:baz.jar!/foo" "bar")
#p"jar:file:baz.jar!/foo")
-(deftest jar-file-truename.1
- (truename "jar:file:baz.jar!/foo")
- (format nil "jar:file:~S/baz.jar!/foo"
- *this-directory*))
-
+(deftest jar-file.truename.1
+ (signals-error (truename "jar:file:baz.jar!/foo")
+ 'file-error)
+ t)
+
+(deftest jar-file.pathname.1
+ (let* ((p #p"jar:file:foo/baz.jar!/")
+ (d (first (pathname-device p))))
+ (values
+ (pathname-directory d) (pathname-name d) (pathname-type d)))
+ (:relative "foo") "baz" "jar")
+
+(deftest jar-file.pathname.2
+ (let* ((p #p"jar:file:baz.jar!/foo.abcl")
+ (d (first (pathname-device p))))
+ (values
+ (pathname-name d) (pathname-type d)
+ (pathname-directory p) (pathname-name p) (pathname-type p)))
+ "baz" "jar"
+ nil "foo" "abcl")
+
+(deftest jar-file.pathname.3
+ (let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/")
+ (d0 (first (pathname-device p)))
+ (d1 (second (pathname-device p))))
+ (values
+ (pathname-name d0) (pathname-type d0)
+ (pathname-name d1) (pathname-type d1)))
+ "baz" "jar"
+ "foo" "abcl")
+
+(deftest jar-file.pathname.4
+ (let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls")
+ (d0 (first (pathname-device p)))
+ (d1 (second (pathname-device p))))
+ (values
+ (pathname-directory d0) (pathname-name d0) (pathname-type d0)
+ (pathname-directory d1) (pathname-name d1) (pathname-type d1)
+ (pathname-directory p) (pathname-name p) (pathname-type p)))
+ (:relative "a") "baz" "jar"
+ (:relative "b" "c") "foo" "abcl"
+ (:relative "this" "that") "foo-20" "cls")
+
+(deftest jar-file.pathname.5
+ (let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls")
+ (d0 (first (pathname-device p)))
+ (d1 (second (pathname-device p))))
+ (values
+ (pathname-directory d0) (pathname-name d0) (pathname-type d0)
+ (pathname-directory d1) (pathname-name d1) (pathname-type d1)
+ (pathname-directory p) (pathname-name p) (pathname-type p)))
+ (:relative "a" "foo" ) "baz" "jar"
+ (:relative "b" "c") "foo" "abcl"
+ (:relative "armed" "bear") "bar-1" "cls")
+
+(deftest jar-file.pathname.6
+ (let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class")
+ (d (first (pathname-device p))))
+
+ (values
+ d
+ (pathname-directory p) (pathname-name p) (pathname-type p)))
+ "http://example.org/abcl.jar"
+ (:relative "org" "armedbear" "lisp") "Version" "class")
+
+(deftest jar-file.pathname.7
+ (let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls")
+ (d (pathname-device p))
+ (d0 (first d))
+ (d1 (second d)))
+ (values
+ d0
+ (pathname-name d1) (pathname-type d1)
+ (pathname-name p) (pathname-type p)))
+ "http://example.org/abcl.jar"
+ "foo" "abcl"
+ "foo-1" "cls")
+
+(deftest jar-file.pathname.8
+ (let* ((p #p"jar:file:/a/b/foo.jar!/")
+ (d (first (pathname-device p))))
+ (values
+ (pathname-directory d) (pathname-name d) (pathname-type d)))
+ (:ABSOLUTE "a" "b") "foo" "jar")
+
+(deftest jar-file.pathname.9
+ (let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp")
+ (d (first (pathname-device p))))
+ (values
+ (pathname-directory d) (pathname-name d) (pathname-type d)
+ (pathname-directory p) (pathname-name p) (pathname-type p)))
+ (:RELATIVE "a" "b") "foo" "jar"
+ (:RELATIVE "c" "d") "foo" "lisp")
+
+
+
+
+
+
Modified: trunk/abcl/test/lisp/abcl/math-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/math-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/math-tests.lisp Tue Jan 26 06:15:48 2010
@@ -35,15 +35,17 @@
#+sbcl `(sb-int:get-floating-point-modes))
#+(or abcl cmu sbcl)
-(defun restore-default-floating-point-modes ()
+(defmacro restore-default-floating-point-modes ()
#+abcl
- (set-floating-point-modes :traps '(:overflow :underflow))
+ `(ext:set-floating-point-modes :traps '(:overflow :underflow))
#+(or cmu sbcl)
- (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)))
+ `(set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)))
#+(or abcl cmu sbcl)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (restore-default-floating-point-modes))
+ (restore-default-floating-point-modes))
+;; (ext:set-floating-point-modes :traps '(:overflow :underflow)))
+;;
(deftest most-negative-fixnum.1
(= (/ most-negative-fixnum -1) (- most-negative-fixnum))
@@ -354,7 +356,7 @@
(expt #c(0 0.0) 4)
#c(0.0 0.0))
-(deftest expt.25
+(deftest expt.26
(expt #c(0 0.0) 4.0)
#c(0.0 0.0))
@@ -451,7 +453,7 @@
(signals-error (truncate least-positive-double-float 2) 'floating-point-underflow)
t)
-(deftest read-from-string.1
+(deftest math.read-from-string.1
#+(or cmu sbcl)
(unwind-protect
(signals-error (read-from-string "1.0f-1000") 'reader-error)
Modified: trunk/abcl/test/lisp/abcl/misc-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/misc-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/misc-tests.lisp Tue Jan 26 06:15:48 2010
@@ -19,12 +19,12 @@
(in-package #:abcl.test.lisp)
-(deftest dotimes.1
+(deftest misc.dotimes.1
(progn
- (fmakunbound 'dotimes.1)
- (defun dotimes.1 ()
+ (fmakunbound 'misc.dotimes.1)
+ (defun misc.dotimes.1 ()
(let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum))
- (dotimes.1))
+ (misc.dotimes.1))
420)
(deftest dotimes.1.compiled
@@ -36,12 +36,12 @@
(dotimes.1.compiled))
420)
-(deftest dotimes.2
+(deftest misc.dotimes.2
(progn
- (fmakunbound 'dotimes.2)
- (defun dotimes.2 (count)
+ (fmakunbound 'misc.dotimes.2)
+ (defun misc.dotimes.2 (count)
(let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum))
- (dotimes.2 10))
+ (misc.dotimes.2 10))
420)
(deftest dotimes.2.compiled
Modified: trunk/abcl/test/lisp/abcl/mop-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/mop-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/mop-tests.lisp Tue Jan 26 06:15:48 2010
@@ -16,11 +16,6 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(load (merge-pathnames "test-utilities.lisp" *load-truename*))
-(compile-file (merge-pathnames "mop-tests-setup.lisp" *load-truename*))
-(load (merge-pathnames "mop-tests-setup" *load-truename*))
-
(in-package #:abcl.test.lisp)
(deftest compute-applicable-methods.foo.1
Modified: trunk/abcl/test/lisp/abcl/package.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/package.lisp (original)
+++ trunk/abcl/test/lisp/abcl/package.lisp Tue Jan 26 06:15:48 2010
@@ -1,32 +1,32 @@
(defpackage #:abcl.test.lisp
(:use #:cl #:abcl-rt)
- (:nicknames "ABCL-TEST")
- (:export #:run))
+ (:nicknames "ABCL-TEST-LISP" "ABCL-TEST")
+ (:export
+ #:run #:run-matching))
(in-package #:abcl.test.lisp)
-(defvar *abcl-lisp-test-directory*
- (pathname (directory-namestring *load-truename*))
- "The directory in which the ABCL test source files are located.")
+(defparameter *abcl-test-directory*
+ (make-pathname :host (pathname-host *load-truename*)
+ :device (pathname-device *load-truename*)
+ :directory (pathname-directory *load-truename*)))
(defun run ()
"Run the Lisp test suite for ABCL."
+ (let ((*default-pathname-defaults* *abcl-test-directory*))
+ (do-tests)))
- (let ((*default-pathname-defaults* *abcl-lisp-test-directory*))
- (rem-all-tests)
-
- (load "test-utilities.lisp")
-
- (load "compiler-tests.lisp")
- (load "condition-tests.lisp")
- (load "mop-tests.lisp")
- (load "file-system-tests.lisp")
- (load "java-tests.lisp")
- (load "math-tests.lisp")
- (load "misc-tests.lisp")
-
- (when (find :unix *features*)
- (load "jar-file.lisp"))
+;;; XXX move this into test-utilities.lisp?
+(defun run-matching (&optional (match "jar-file."))
+ (let* ((matching (string-upcase match))
+ (tests
+ (remove-if-not
+ (lambda (name) (search matching name))
+ (mapcar (lambda (entry)
+ (symbol-name (abcl-rt::name entry)))
+ (rest abcl-rt::*entries*)))))
+ (dolist (test tests)
+ (do-test (intern test :abcl.test.lisp)))))
+
- (do-tests)))
\ No newline at end of file
Modified: trunk/abcl/test/lisp/abcl/test-utilities.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/test-utilities.lisp (original)
+++ trunk/abcl/test/lisp/abcl/test-utilities.lisp Tue Jan 26 06:15:48 2010
@@ -24,6 +24,7 @@
#+(and lispworks win32)
(pushnew :windows *features*)
+#+nil ;; Taken care of by ASDF
(unless (member "ABCL-RT" *modules* :test #'string=)
(load (merge-pathnames "rt-package.lisp" *load-truename*))
(load #+abcl (compile-file-if-needed (merge-pathnames "rt.lisp" *load-truename*))
@@ -32,15 +33,17 @@
#-abcl (compile-file (merge-pathnames "rt.lisp" *load-truename*)))
(provide "ABCL-RT"))
-(in-package #:abcl-regression-test)
-(export '(signals-error))
+(in-package #:abcl-regression-test)
(defmacro signals-error (form error-name)
`(locally (declare (optimize safety))
(handler-case ,form
(condition (c) (typep c ,error-name))
(:no-error (&rest ignored) (declare (ignore ignored)) nil))))
+(export '(signals-error))
+
+
#+nil (rem-all-tests)
Added: trunk/abcl/test/src/org/armedbear/lisp/PathnameTest.java
==============================================================================
--- (empty file)
+++ trunk/abcl/test/src/org/armedbear/lisp/PathnameTest.java Tue Jan 26 06:15:48 2010
@@ -0,0 +1,58 @@
+package org.armedbear.lisp;
+
+import java.net.MalformedURLException;
+import org.junit.Test;
+import static org.junit.Assert.*;
+import org.junit.runner.JUnitCore;
+
+
+import java.net.URL;
+import java.io.File;
+import java.io.FileWriter;
+import java.io.InputStream;
+import java.io.InputStreamReader;
+import java.io.IOException;
+
+public class PathnameTest
+{
+ public static void main(final String args[]) {
+ JUnitCore.main("org.armedbear.lisp.PathnameTest");
+ }
+
+ @Test
+ public void constructorURL()
+ {
+ URL url = null;
+ try {
+ url = new URL("file:///Users/evenson/work/abcl/build/classes/org/armedbear/lisp/boot.lisp");
+ } catch (MalformedURLException e) {
+ System.out.println(e.getMessage());
+ }
+ Pathname pathname = new Pathname(url);
+ assertNotNull(pathname);
+ assertNotNull(pathname.getNamestring());
+ assertNotNull(pathname.name);
+ assertNotNull(pathname.type);
+ assertNotNull(pathname.directory);
+ }
+
+ @Test
+ public void getInputStream() throws IOException {
+ File file = File.createTempFile("foo", "lisp");
+ FileWriter output = new FileWriter(file);
+ String contents = "(defun foo () 42)";
+ output.append(contents);
+ output.close();
+ Pathname pathname = Pathname.makePathname(file);
+ InputStream input = pathname.getInputStream();
+ InputStreamReader reader = new InputStreamReader(input);
+ char[] buffer = new char[1024];
+ StringBuilder result = new StringBuilder();
+ int i;
+ while((i = reader.read(buffer, 0, buffer.length)) != -1) {
+ result.append(buffer, 0, i);
+ }
+ assertEquals(contents, result.toString());
+ file.delete();
+ }
+}
Added: trunk/abcl/test/src/org/armedbear/lisp/StreamTest.java
==============================================================================
--- (empty file)
+++ trunk/abcl/test/src/org/armedbear/lisp/StreamTest.java Tue Jan 26 06:15:48 2010
@@ -0,0 +1,31 @@
+package org.armedbear.lisp;
+
+import static org.junit.Assert.*;
+
+import java.io.File;
+import java.io.FileWriter;
+import org.junit.Test;
+import java.io.IOException;
+
+public class StreamTest
+{
+ @Test
+ public void readLispObject() {
+ File file = null;
+ try {
+ file = File.createTempFile("foo", "lisp");
+ FileWriter output = new FileWriter(file);
+ String contents = "(defun foo () 42)";
+ output.append(contents);
+ output.close();
+ } catch (IOException e) {
+ System.out.println("Failed to create temp file" + e);
+ return;
+ }
+ Pathname pathname = Pathname.makePathname(file);
+ Stream in = new Stream(Symbol.SYSTEM_STREAM, pathname.getInputStream(), Symbol.CHARACTER);
+ LispObject o = in.read(false, Lisp.EOF, false, LispThread.currentThread());
+ assertFalse(o.equals(Lisp.NIL));
+ file.delete();
+ }
+}
\ No newline at end of file
More information about the armedbear-cvs
mailing list