Changeset 12402


Ignore:
Timestamp:
01/26/10 11:15:48 (12 years ago)
Author:
Mark Evenson
Message:

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.

Location:
trunk/abcl
Files:
2 added
1 deleted
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/abcl.asd

    r12338 r12402  
    1111
    1212(defmethod perform :after ((o load-op) (c (eql (find-system :abcl))))
    13   (operate 'load-op :abcl-tests :force t)
    1413  (operate 'load-op :abcl-test-lisp :force t)
    1514  (operate 'load-op :cl-bench :force t)
     
    2120  (operate 'test-op :abcl-tests :force t))
    2221
    23 ;;; A collection of test suites for ABCL.
    24 (defsystem :abcl-tests
    25   :version "2.0"
    26   :depends-on (:abcl-test-lisp
    27                :ansi-compiled :ansi-interpreted
    28                :cl-bench))
    29 
    30 (defmethod perfom :before ((o test-op (c (eql find-system :abcl-tests))))
    31   (operate 'load-op :abcl-test-lisp)
    32   (operate 'load-op :ansi-compiled)
    33   (operate 'load-op :cl-bench))
    34 
    35 ;;;  Run via (asdf:operate 'asdf:test-op :abcl-tests :force t)
    36 (defmethod perform ((o test-op) (c (eql (find-system :abcl-tests))))
    37   ;; Additional test suite invocations would go here.
    38   (operate 'test-op :abcl-test-lisp)
    39   (operate 'test-op :ansi-compiled)
    40   (operate 'test-op :cl-bench))
    41 
    4222;;; Test ABCL with the Lisp unit tests collected in "test/lisp/abcl"
    4323(defsystem :abcl-test-lisp :version "1.1" :components
    44      ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components
    45          ((:file "rt-package") (:file "rt")))
     24     ((:module abcl-rt
     25                     :pathname "test/lisp/abcl/" :serial t :components
     26         ((:file "rt-package") (:file "rt")
     27                      (:file "test-utilities")))
    4628      (:module package  :depends-on (abcl-rt)
    4729         :pathname "test/lisp/abcl/" :components
    48          ((:file "package")))))
    49 (defmethod perform :before ((o test-op) (c (eql (find-system
    50                                                  :abcl-test-lisp))))
    51   (operate 'load-op :abcl-test-lisp :force t))
     30         ((:file "package")))
     31            (:module test :depends-on (package)
     32         :pathname "test/lisp/abcl/" :components
     33                     ((:file "compiler-tests")
     34                      (:file "condition-tests")
     35                      (:file "mop-tests-setup")
     36                      (:file "mop-tests" :depends-on ("mop-tests-setup"))
     37                      (:file "file-system-tests")
     38                      (:file "jar-file")
     39                      (:file "math-tests")
     40                      (:file "misc-tests")
     41                      (:file "pathname-tests")))))
     42
    5243(defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
    5344   "Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
    54    (funcall (intern (symbol-name 'run) :abcl-test)))
     45   (funcall (intern (symbol-name 'run) :abcl.test.lisp)))
    5546
    5647;;; Test ABCL with the interpreted ANSI tests
  • trunk/abcl/src/org/armedbear/lisp/zip.java

    r12288 r12402  
    4040import java.io.FileOutputStream;
    4141import java.io.IOException;
     42import java.util.HashSet;
     43import java.util.Set;
    4244import java.util.zip.ZipEntry;
    4345import java.util.zip.ZipOutputStream;
     
    4850    private zip()
    4951    {
    50         super("zip", PACKAGE_SYS, true, "pathname pathnames");
     52        super("zip", PACKAGE_SYS, true, "pathname pathnames &optional topdir");
    5153    }
    5254
     
    9597    }
    9698
     99    @Override
     100    public LispObject execute(LispObject first, LispObject second, LispObject third)
     101    {
     102        Pathname zipfilePathname = coerceToPathname(first);
     103        byte[] buffer = new byte[4096];
     104        try {
     105            String zipfileNamestring = zipfilePathname.getNamestring();
     106            if (zipfileNamestring == null)
     107                return error(new SimpleError("Pathname has no namestring: " +
     108                                              zipfilePathname.writeToString()));
     109            ZipOutputStream out =
     110                new ZipOutputStream(new FileOutputStream(zipfileNamestring));
     111            Pathname root = (Pathname)coerceToPathname(third);
     112            String rootPath = root.getDirectoryNamestring();
     113            int rootPathLength = rootPath.length();
     114            Set<String> directories = new HashSet<String>();
     115            LispObject list = second;
     116            while (list != NIL) {
     117                Pathname pathname = coerceToPathname(list.car());
     118                String namestring = pathname.getNamestring();
     119                if (namestring == null) {
     120                    // Clean up before signalling error.
     121                    out.close();
     122                    File zipfile = new File(zipfileNamestring);
     123                    zipfile.delete();
     124                    return error(new SimpleError("Pathname has no namestring: " +
     125                                                  pathname.writeToString()));
     126                }
     127                String directory = "";
     128                String dir = pathname.getDirectoryNamestring();
     129                if (dir.length() > rootPathLength) {
     130                  String d = dir.substring(rootPathLength);
     131                  int i = 0;
     132                  int j;
     133                  while ((j = d.indexOf(File.separator, i)) != -1) {
     134                    i = j + 1;
     135                    directory = d.substring(0, j).replace(File.separatorChar, '/') + "/";
     136                    if (!directories.contains(directory)) {
     137                      directories.add(directory);
     138                      ZipEntry entry = new ZipEntry(directory);
     139                      out.putNextEntry(entry);
     140                      out.closeEntry();
     141                    }
     142                  }
     143                }
     144                File file = new File(namestring);
     145                if (file.isDirectory()) {
     146                    list = list.cdr();
     147                    continue;
     148                }
     149                FileInputStream in = new FileInputStream(file);
     150                ZipEntry entry = new ZipEntry(directory + file.getName());
     151                out.putNextEntry(entry);
     152                int n;
     153                while ((n = in.read(buffer)) > 0)
     154                    out.write(buffer, 0, n);
     155                out.closeEntry();
     156                in.close();
     157                list = list.cdr();
     158            }
     159            out.close();
     160        }
     161        catch (IOException e) {
     162            return error(new LispError(e.getMessage()));
     163        }
     164        return zipfilePathname;
     165    }
     166
     167
    97168    private static final Primitive zip = new zip();
    98169}
  • trunk/abcl/test/lisp/abcl/condition-tests.lisp

    r11599 r12402  
    1717;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1818
    19 (load (merge-pathnames "test-utilities.lisp" *load-truename*))
    20 
    2119(in-package #:abcl.test.lisp)
    2220
  • trunk/abcl/test/lisp/abcl/file-system-tests.lisp

    r11599 r12402  
    3333                 :device (pathname-device *load-truename*)
    3434                 :directory (pathname-directory *load-truename*)))
    35 
    36 (defmacro signals-error (form error-name)
    37   `(locally (declare (optimize safety))
    38      (handler-case ,form
    39        (error (c) (typep c ,error-name))
    40        (:no-error (&rest ignored) (declare (ignore ignored)) nil))))
    4135
    4236(defun pathnames-equal-p (pathname1 pathname2)
     
    426420(pushnew 'user-homedir-pathname.1 *expected-failures*)
    427421
    428 (deftest directory-namestring.1
     422(deftest file-system.directory-namestring.1
    429423  (let ((pathname (user-homedir-pathname)))
    430424    (equal (namestring pathname) (directory-namestring pathname)))
     
    435429  nil)
    436430#+clisp
    437 (pushnew 'directory-namestring.1 *expected-failures*)
    438 
    439 (deftest directory-namestring.2
     431(pushnew 'file-system.directory-namestring.1 *expected-failures*)
     432
     433(deftest file.system.directory-namestring.2
    440434  (let ((pathname (user-homedir-pathname)))
    441435    (equal (directory-namestring pathname)
     
    443437  t)
    444438#+clisp
    445 (pushnew 'directory-namestring.2 *expected-failures*)
     439(pushnew 'file-system.directory-namestring.2 *expected-failures*)
    446440
    447441(deftest ensure-directories-exist.1
  • trunk/abcl/test/lisp/abcl/jar-file.lisp

    r12343 r12402  
    11(in-package #:abcl.test.lisp)
    22
    3 #-:unix (error "Load test setup currently needs UNIX shell script support.")
    4 
    5 (defun load-init ()
    6   (let* ((*default-pathname-defaults* *this-directory*)
    7          (asdf::*verbose-out* *standard-output*)
    8          (package-command (format nil "cd ~A; sh ~A"
    9                                   *this-directory*
    10                                   (merge-pathnames "package-load.sh"))))
     3(defvar *jar-file-init* nil)
     4
     5;;; From CL-FAD
     6(defvar *stream-buffer-size* 8192)
     7(defun cl-fad-copy-stream (from to &optional (checkp t))
     8  "Copies into TO \(a stream) from FROM \(also a stream) until the end
     9of FROM is reached, in blocks of *stream-buffer-size*.  The streams
     10should have the same element type.  If CHECKP is true, the streams are
     11checked for compatibility of their types."
     12  (when checkp
     13    (unless (subtypep (stream-element-type to) (stream-element-type from))
     14      (error "Incompatible streams ~A and ~A." from to)))
     15  (let ((buf (make-array *stream-buffer-size*
     16                         :element-type (stream-element-type from))))
     17    (loop
     18     (let ((pos (read-sequence buf from)))
     19       (when (zerop pos) (return))
     20       (write-sequence buf to :end pos))))
     21  (values))
     22
     23(defun cl-fad-copy-file (from to &key overwrite)
     24  "Copies the file designated by the non-wild pathname designator FROM
     25to the file designated by the non-wild pathname designator TO.  If
     26OVERWRITE is true overwrites the file designtated by TO if it exists."
     27  (let ((element-type '(unsigned-byte 8)))
     28    (with-open-file (in from :element-type element-type)
     29      (with-open-file (out to :element-type element-type
     30                              :direction :output
     31                              :if-exists (if overwrite
     32                                           :supersede :error))
     33        (cl-fad-copy-stream in out))))
     34  (values))
     35
     36(defun jar-file-init ()
     37  (let* ((*default-pathname-defaults*  *abcl-test-directory*)
     38         (asdf::*verbose-out* *standard-output*))
    1139    (compile-file "foo.lisp")
    1240    (compile-file "bar.lisp")
    1341    (compile-file "eek.lisp")
    14     (asdf:run-shell-command package-command))
     42    (let* ((dir (merge-pathnames "tmp/" *abcl-test-directory*))
     43           (sub (merge-pathnames "a/b/" dir)))
     44      (when (probe-directory dir)
     45        (delete-directory-and-files dir))
     46      (ensure-directories-exist sub)
     47      (sys:unzip (merge-pathnames "foo.abcl")
     48                 dir)
     49      (sys:unzip (merge-pathnames "foo.abcl")
     50                 sub)
     51      (cl-fad-copy-file (merge-pathnames "bar.abcl")
     52                 (merge-pathnames "bar.abcl" dir))
     53      (cl-fad-copy-file (merge-pathnames "bar.abcl")
     54                 (merge-pathnames "bar.abcl" sub))
     55      (cl-fad-copy-file (merge-pathnames "eek.lisp")
     56                 (merge-pathnames "eek.lisp" dir))
     57      (cl-fad-copy-file (merge-pathnames "eek.lisp")
     58                 (merge-pathnames "eek.lisp" sub))
     59      (sys:zip (merge-pathnames "baz.jar")
     60               (append
     61                (directory (merge-pathnames "*" dir))
     62                (directory (merge-pathnames "*" sub)))
     63               dir)
     64      (delete-directory-and-files dir)))
    1565  (setf *jar-file-init* t))
    1666
    17 (defvar *jar-file-init* nil)
    18 
    1967(defmacro with-jar-file-init (&rest body)
    20   `(let ((*default-pathname-defaults* *this-directory*))
     68  `(let ((*default-pathname-defaults* *abcl-test-directory*))
    2169     (progn
    2270       (unless *jar-file-init*
    23          (load-init))
     71         (jar-file-init))
    2472       ,@body)))
     73
     74#+nil
     75(defmacro with-jar-file-init (&rest body)
     76  `(progv '(*default-pathname-defaults*) '(,*abcl-test-directory*)
     77    (unless *jar-file-init*
     78      (load-init))
     79    ,@body))
     80
     81(deftest jar-file.load.1
     82    (with-jar-file-init
     83      (load "jar:file:baz.jar!/foo"))
     84  t)
     85
     86(deftest jar-file.load.2
     87    (with-jar-file-init
     88      (load "jar:file:baz.jar!/bar"))
     89  t)
     90
     91(deftest jar-file.load.3
     92    (with-jar-file-init
     93      (load "jar:file:baz.jar!/bar.abcl"))
     94  t)
     95
     96(deftest jar-file.load.4
     97    (with-jar-file-init
     98      (load "jar:file:baz.jar!/eek"))
     99  t)
     100
     101(deftest jar-file.load.5
     102    (with-jar-file-init
     103      (load "jar:file:baz.jar!/eek.lisp"))
     104  t)
     105
     106(deftest jar-file.load.6
     107    (with-jar-file-init
     108      (load "jar:file:baz.jar!/a/b/foo"))
     109  t)
     110
     111(deftest jar-file.load.7
     112    (with-jar-file-init
     113      (load "jar:file:baz.jar!/a/b/bar"))
     114  t)
     115
     116(deftest jar-file.load.8
     117    (with-jar-file-init
     118      (load "jar:file:baz.jar!/a/b/bar.abcl"))
     119  t)
     120
     121(deftest jar-file.load.9
     122    (with-jar-file-init
     123      (load "jar:file:baz.jar!/a/b/eek"))
     124  t)
     125
     126(deftest jar-file.load.10
     127    (with-jar-file-init
     128      (load "jar:file:baz.jar!/a/b/eek.lisp"))
     129  t)
     130
     131(deftest jar-file.probe-file.1
     132    (with-jar-file-init
     133        (probe-file "jar:file:baz.jar!/eek.lisp"))
     134  #p#.(format nil "jar:file:~A/baz.jar!/eek.lisp"
     135              (namestring *abcl-test-directory*)))
     136
     137(deftest jar-file.probe-file.2
     138    (with-jar-file-init
     139        (probe-file "jar:file:baz.jar!/a/b/bar.abcl"))
     140  #p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl"
     141              (namestring *abcl-test-directory*)))
     142
     143(deftest jar-file.probe-file.3
     144    (with-jar-file-init
     145        (probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._"))
     146   #p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._"
     147                       (namestring *abcl-test-directory*)))
     148
     149(deftest jar-file.probe-file.4
     150    (with-jar-file-init
     151        (probe-file "jar:file:baz.jar!/a/b"))
     152  nil)
     153
     154(deftest jar-file.probe-file.5
     155    (with-jar-file-init
     156        (probe-file "jar:file:baz.jar!/a/b/"))
     157  #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
     158                       (namestring *abcl-test-directory*)))
     159
     160(deftest jar-file.merge-pathnames.1
     161    (merge-pathnames
     162     "/bar.abcl" #p"jar:file:baz.jar!/foo")
     163  #p"jar:file:baz.jar!/bar.abcl")
     164
     165(deftest jar-file.merge-pathnames.2
     166    (merge-pathnames
     167     "/bar.abcl" #p"jar:file:baz.jar!/foo/")
     168  #p"jar:file:baz.jar!/foo/bar.abcl")
     169
     170(deftest jar-file.merge-pathnames.3
     171    (merge-pathnames
     172     "jar:file:baz.jar!/foo" "bar")
     173  #p"jar:file:baz.jar!/foo")
     174
     175(deftest jar-file.truename.1
     176    (signals-error (truename "jar:file:baz.jar!/foo")
     177                   'file-error)
     178  t)
     179
     180
     181(deftest jar-file.pathname.1
     182    (let* ((p #p"jar:file:foo/baz.jar!/")
     183           (d (first (pathname-device p))))
     184      (values
     185       (pathname-directory d) (pathname-name d) (pathname-type d)))
     186  (:relative "foo") "baz" "jar")
     187
     188(deftest jar-file.pathname.2
     189    (let* ((p #p"jar:file:baz.jar!/foo.abcl")
     190           (d (first (pathname-device p))))
     191      (values
     192       (pathname-name d) (pathname-type d)
     193       (pathname-directory p) (pathname-name p) (pathname-type p)))
     194  "baz" "jar"
     195   nil "foo" "abcl")
     196   
     197(deftest jar-file.pathname.3
     198    (let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/")
     199           (d0 (first (pathname-device p)))
     200           (d1 (second (pathname-device p))))
     201      (values
     202       (pathname-name d0) (pathname-type d0)
     203       (pathname-name d1) (pathname-type d1)))
     204  "baz" "jar"
     205  "foo" "abcl")
     206
     207(deftest jar-file.pathname.4
     208    (let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls")
     209           (d0 (first (pathname-device p)))
     210           (d1 (second (pathname-device p))))
     211      (values
     212       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
     213       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
     214       (pathname-directory p) (pathname-name p) (pathname-type p)))
     215  (:relative "a") "baz" "jar"
     216  (:relative "b" "c") "foo" "abcl"
     217  (:relative "this" "that") "foo-20" "cls")
     218
     219(deftest jar-file.pathname.5
     220    (let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls")
     221           (d0 (first (pathname-device p)))
     222           (d1 (second (pathname-device p))))
     223      (values
     224       (pathname-directory d0) (pathname-name d0) (pathname-type d0)
     225       (pathname-directory d1) (pathname-name d1) (pathname-type d1)
     226       (pathname-directory p) (pathname-name p) (pathname-type p)))
     227  (:relative "a" "foo" ) "baz" "jar"
     228  (:relative "b" "c") "foo" "abcl"
     229  (:relative "armed" "bear") "bar-1" "cls")
     230
     231(deftest jar-file.pathname.6
     232    (let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class")
     233           (d (first (pathname-device p))))
     234
     235      (values
     236       d
     237       (pathname-directory p) (pathname-name p) (pathname-type p)))
     238  "http://example.org/abcl.jar"
     239  (:relative "org" "armedbear" "lisp") "Version" "class")
     240
     241(deftest jar-file.pathname.7
     242    (let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls")
     243           (d (pathname-device p))
     244           (d0 (first d))
     245           (d1 (second d)))
     246      (values
     247       d0
     248       (pathname-name d1) (pathname-type d1)
     249       (pathname-name p) (pathname-type p)))
     250  "http://example.org/abcl.jar"
     251  "foo" "abcl"
     252  "foo-1" "cls")
     253
     254(deftest jar-file.pathname.8
     255    (let* ((p #p"jar:file:/a/b/foo.jar!/")
     256           (d (first (pathname-device p))))
     257      (values
     258       (pathname-directory d) (pathname-name d) (pathname-type d)))
     259  (:ABSOLUTE "a" "b") "foo" "jar")
     260
     261(deftest jar-file.pathname.9
     262    (let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp")
     263           (d (first (pathname-device p))))
     264      (values
     265       (pathname-directory d) (pathname-name d) (pathname-type d)
     266       (pathname-directory p) (pathname-name p) (pathname-type p)))
     267  (:RELATIVE "a" "b") "foo" "jar"
     268  (:RELATIVE "c" "d") "foo" "lisp")
     269
     270     
     271     
     272             
     273
     274       
     275       
     276
    25277 
    26 
    27 (deftest jar-file-load.1
    28     (with-jar-file-init
    29         (load "foo"))
    30   t)
    31 
    32 (deftest jar-file-load.2
    33     (with-jar-file-init
    34       (load "foo.lisp"))
    35   t)
    36 
    37 (deftest jar-file-load.3
    38     (with-jar-file-init
    39       (load "foo.abcl"))
    40   t)
    41 
    42 (deftest jar-file-load.4
    43     (with-jar-file-init
    44       (load "jar:file:baz.jar!/foo"))
    45   t)
    46 
    47 (deftest jar-file-load.6
    48     (with-jar-file-init
    49       (load "jar:file:baz.jar!/bar"))
    50   t)
    51 
    52 (deftest jar-file-load.7
    53     (with-jar-file-init
    54       (load "jar:file:baz.jar!/bar.abcl"))
    55   t)
    56 
    57 (deftest jar-file-load.8
    58     (with-jar-file-init
    59       (load "jar:file:baz.jar!/eek"))
    60   t)
    61 
    62 (deftest jar-file-load.9
    63     (with-jar-file-init
    64       (load "jar:file:baz.jar!/eek.lisp"))
    65   t)
    66 
    67 
    68 (deftest jar-file-probe-file.1
    69     (with-jar-file-init
    70         (probe-file "jar:file:baz.jar!/eek.lisp"))
    71   #p"jar:file:baz.jar!/eek.lisp") ; WRONG: PROBE-FILE should return
    72                                   ; TRUENAME on existence.
    73 
    74 
    75 (deftest jar-file-merge-pathnames.1
    76     (merge-pathnames
    77      "!/foo" #p"jar:file:baz.jar")
    78   #p"jar:file:baz.jar!/foo")
    79 
    80 (deftest jar-file-truename.1
    81     (truename "jar:file:baz.jar!/foo")
    82   (format nil "jar:file:~S/baz.jar!/foo"
    83           *this-directory*))
    84          
    85 
    86 
    87 
    88  
  • trunk/abcl/test/lisp/abcl/math-tests.lisp

    r11955 r12402  
    3636
    3737#+(or abcl cmu sbcl)
    38 (defun restore-default-floating-point-modes ()
     38(defmacro restore-default-floating-point-modes ()
    3939  #+abcl
    40   (set-floating-point-modes :traps '(:overflow :underflow))
     40  `(ext:set-floating-point-modes :traps '(:overflow :underflow))
    4141  #+(or cmu sbcl)
    42   (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)))
     42  `(set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)))
    4343
    4444#+(or abcl cmu sbcl)
    4545(eval-when (:compile-toplevel :load-toplevel :execute)
    46   (restore-default-floating-point-modes))
     46   (restore-default-floating-point-modes))
     47;;  (ext:set-floating-point-modes :traps '(:overflow :underflow)))
     48;;
    4749
    4850(deftest most-negative-fixnum.1
     
    355357  #c(0.0 0.0))
    356358
    357 (deftest expt.25
     359(deftest expt.26
    358360  (expt #c(0 0.0) 4.0)
    359361  #c(0.0 0.0))
     
    452454  t)
    453455
    454 (deftest read-from-string.1
     456(deftest math.read-from-string.1
    455457  #+(or cmu sbcl)
    456458  (unwind-protect
  • trunk/abcl/test/lisp/abcl/misc-tests.lisp

    r11599 r12402  
    2020(in-package #:abcl.test.lisp)
    2121
    22 (deftest dotimes.1
     22(deftest misc.dotimes.1
    2323  (progn
    24     (fmakunbound 'dotimes.1)
    25     (defun dotimes.1 ()
     24    (fmakunbound 'misc.dotimes.1)
     25    (defun misc.dotimes.1 ()
    2626      (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum))
    27     (dotimes.1))
     27    (misc.dotimes.1))
    2828  420)
    2929
     
    3737  420)
    3838
    39 (deftest dotimes.2
     39(deftest misc.dotimes.2
    4040  (progn
    41     (fmakunbound 'dotimes.2)
    42     (defun dotimes.2 (count)
     41    (fmakunbound 'misc.dotimes.2)
     42    (defun misc.dotimes.2 (count)
    4343      (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum))
    44     (dotimes.2 10))
     44    (misc.dotimes.2 10))
    4545  420)
    4646
  • trunk/abcl/test/lisp/abcl/mop-tests.lisp

    r12395 r12402  
    1717;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1818
    19 
    20 (load (merge-pathnames "test-utilities.lisp" *load-truename*))
    21 (compile-file (merge-pathnames "mop-tests-setup.lisp" *load-truename*))
    22 (load (merge-pathnames "mop-tests-setup" *load-truename*))
    23 
    2419(in-package #:abcl.test.lisp)
    2520
  • trunk/abcl/test/lisp/abcl/package.lisp

    r12395 r12402  
    11(defpackage #:abcl.test.lisp
    22  (:use #:cl #:abcl-rt)
    3   (:nicknames "ABCL-TEST")
    4   (:export #:run))
     3  (:nicknames "ABCL-TEST-LISP" "ABCL-TEST")
     4  (:export
     5   #:run #:run-matching))
    56(in-package #:abcl.test.lisp)
    67
    7 (defvar *abcl-lisp-test-directory*
    8   (pathname (directory-namestring *load-truename*))
    9   "The directory in which the ABCL test source files are located.")
     8(defparameter *abcl-test-directory*
     9   (make-pathname :host (pathname-host *load-truename*)
     10                  :device (pathname-device *load-truename*)
     11                  :directory (pathname-directory *load-truename*)))
    1012
    1113(defun run ()
    1214  "Run the Lisp test suite for ABCL."
    13 
    14   (let ((*default-pathname-defaults* *abcl-lisp-test-directory*))
    15     (rem-all-tests)
    16 
    17     (load "test-utilities.lisp")
    18 
    19     (load "compiler-tests.lisp")
    20     (load "condition-tests.lisp")
    21     (load "mop-tests.lisp")
    22     (load "file-system-tests.lisp")
    23     (load "java-tests.lisp")
    24     (load "math-tests.lisp")
    25     (load "misc-tests.lisp")
    26 
    27     (when (find :unix *features*)
    28       (load "jar-file.lisp"))
    29 
     15  (let ((*default-pathname-defaults* *abcl-test-directory*))
    3016    (do-tests)))
    3117
     18;;; XXX move this into test-utilities.lisp?
     19(defun run-matching (&optional (match "jar-file."))
     20  (let* ((matching (string-upcase match))
     21         (tests
     22          (remove-if-not
     23           (lambda (name) (search matching name))
     24           (mapcar (lambda (entry)
     25                     (symbol-name (abcl-rt::name entry)))
     26                   (rest abcl-rt::*entries*)))))
     27    (dolist (test tests)
     28      (do-test (intern test :abcl.test.lisp)))))
     29   
     30
     31
    3232 
  • trunk/abcl/test/lisp/abcl/test-utilities.lisp

    r11599 r12402  
    2525(pushnew :windows *features*)
    2626
     27#+nil ;; Taken care of by ASDF
    2728(unless (member "ABCL-RT" *modules* :test #'string=)
    2829  (load (merge-pathnames "rt-package.lisp" *load-truename*))
     
    3334  (provide "ABCL-RT"))
    3435
     36
    3537(in-package #:abcl-regression-test)
    36 
    37 (export '(signals-error))
    3838
    3939(defmacro signals-error (form error-name)
     
    4242       (condition (c) (typep c ,error-name))
    4343       (:no-error (&rest ignored) (declare (ignore ignored)) nil))))
     44(export '(signals-error))
     45
     46
    4447
    4548#+nil (rem-all-tests)
Note: See TracChangeset for help on using the changeset viewer.