Changeset 15332

Timestamp:

06/26/20 13:23:35 (3 years ago)

Author:

Mark Evenson

Message:

Revisions for the long neglected ABCL/TEST/LISP suite

Restore loading under SBCL and CCL.

FIXME: package-local-nicknames-tests only runs once in the same
process, causing a mysterious failure on the second time.

Location:

trunk/abcl

Files:

• abcl.asd (modified) (2 diffs)
• test/lisp/abcl/clos-tests.lisp (modified) (11 diffs)
• test/lisp/abcl/compiler-tests.lisp (modified) (2 diffs)
• test/lisp/abcl/package-local-nicknames-tests.lisp (modified) (1 diff)
• test/lisp/abcl/package.lisp (modified) (1 diff)
• test/lisp/abcl/pathname-tests.lisp (modified) (2 diffs)
• test/lisp/abcl/wild-pathnames.lisp (modified) (1 diff)

trunk/abcl/abcl.asd

@@ -44 +44 @@
                          (:file "bugs" :depends-on 
                                 ("file-system-tests"))
+                         #+abcl
                          (:file "wild-pathnames"
                                 :depends-on ("file-system-tests"))
@@ -52 +53 @@
                          #+abcl 
                          (:file "java")
-                         #+abcl
                          (:file "pathname-tests" :depends-on 
                                 ("utilities"))

trunk/abcl/test/lisp/abcl/clos-tests.lisp

@@ -22 +22 @@
 
 (in-package #:abcl.test.lisp)
-
 
 
@@ -246 +245 @@
 ;; From SBCL: method combination (long form) with arguments
 
+#-ccl ;; "The value (ABCL.TEST.LISP::EXTRA :EXTRA) is not of the expected type SYMBOL."
 (define-method-combination dmc-test.5 ()
   ((method-list *))
@@ -251 +251 @@
   `(progn ,@(mapcar (lambda (method) `(call-method ,method)) method-list)))
 
+#-ccl ;; "The value (ABCL.TEST.LISP::EXTRA :EXTRA) is not of the expected type SYMBOL."
 (defgeneric dmc-test-mc.5 (p1 p2 s)
   (:method-combination dmc-test.5)
@@ -454 +455 @@
   T)
 
+#-ccl ;; "The value (ABCL.TEST.LISP::A :DEFAULT) is not of the expected type SYMBOL."
 (define-method-combination dmc-test-args-with-optional.2 ()
   ((methods *))
@@ -461 +463 @@
                  ,a)))
 
+#-ccl ;; "The value (ABCL.TEST.LISP::A :DEFAULT) is not of the expected type SYMBOL."
 (defgeneric dmc-test-args-with-optional.2 (x &optional b)
   (:method-combination dmc-test-args-with-optional.2)
@@ -475 +478 @@
   T)
 
+#-ccl ;; The value (ABCL.TEST.LISP::A :DEFAULT) is not of the expected type SYMBOL.
 (define-method-combination dmc-test-args-with-optional.3 ()
   ((methods *))
@@ -482 +486 @@
                  ,a)))
 
+#-ccl ;; The value (ABCL.TEST.LISP::A :DEFAULT) is not of the expected type SYMBOL.
 (defgeneric dmc-test-args-with-optional.3 (x)
   (:method-combination dmc-test-args-with-optional.3)
   (:method (x) (progn x)))
 
+#-ccl ;; The value (ABCL.TEST.LISP::A :DEFAULT) is not of the expected type SYMBOL.
 (deftest dmc-test-args-with-optional.3
     :documentation "TODO"
@@ -491 +497 @@
   nil)
 
-
+#-ccl ;; The value (ABCL.TEST.LISP::A :DEFAULT ABCL.TEST.LISP::SUP-P) is not of the expected type SYMBOL.
 (define-method-combination dmc-test-args-with-optional.4 ()
   ((methods ()))
@@ -499 +505 @@
           (values ,a ,sup-p)))
 
+#-ccl
 (defgeneric dmc-test-args-with-optional.4a (x &optional b)
   (:method-combination dmc-test-args-with-optional.4)
   (:method (x &optional b) (progn x b)))
 
+#-ccl
 (deftest dmc-test-args-with-optional.4a
     (dmc-test-args-with-optional.4a T)
@@ -508 +516 @@
   nil)
 
+#-ccl
 (deftest dmc-test-args-with-optional.4b
     (dmc-test-args-with-optional.4a T T)
@@ -513 +522 @@
   T)
 
+#-ccl
 (defgeneric dmc-test-args-with-optional.4c (x)
   (:method-combination dmc-test-args-with-optional.4)
   (:method (x) (progn x)))
 
+#-ccl
 (deftest dmc-test-args-with-optional.4c
     :documentation "TODO"

trunk/abcl/test/lisp/abcl/compiler-tests.lisp

@@ -23 +23 @@
 (in-package #:abcl.test.lisp)
 
-(defconstant most-positive-java-long 9223372036854775807)
-(defconstant most-negative-java-long -9223372036854775808)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar most-positive-java-long 9223372036854775807)
+  (defvar most-negative-java-long -9223372036854775808))
 
 #+abcl
@@ -105 +106 @@
 #+allegro (pushnew 'plus.3 *expected-failures*)
 
-#-clisp
+#+abcl
 (define-compiler-test plus.4
   (lambda (x y)

trunk/abcl/test/lisp/abcl/package-local-nicknames-tests.lisp

@@ -19 +19 @@
 
 ;;; Most of these tests are adapted from the SBCL test suite.
+
+;;;; FIXME:  re-running these tests in the same process fails the second time due to interactions
+;;;          with the problems with DEFPACKAGE "only being run once"
 
 (in-package #:abcl.test.lisp)

trunk/abcl/test/lisp/abcl/package.lisp

@@ -1 +1 @@
 (defpackage #:abcl.test.lisp
   (:use #:cl #:abcl-rt)
-  (:nicknames "ABCL-TEST-LISP" "ABCL-TEST")
+  (:nicknames "ABCL-TEST-LISP" "ABCL-TEST" "ABCL/TEST/LISP")
   (:export 
    #:run 

trunk/abcl/test/lisp/abcl/pathname-tests.lisp

@@ -563 +563 @@
 
 ;; If the prefix isn't a defined logical host, it's not a logical pathname.
-#-(or cmu (and clisp windows))
+#-(or ccl cmu (and clisp windows))
 ;; CMUCL parses this as (:ABSOLUTE #<SEARCH-LIST foo>) "bar.baz" "42".
 ;; CLISP signals a parse error reading #p"foo:bar.baz.42".
@@ -1335 +1335 @@
 (pushnew 'sbcl.26 *expected-failures*)
 
-(setf (logical-pathname-translations "scratch")
-      '(("**;*.*.*" "/usr/local/doc/**/*")))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf (logical-pathname-translations "scratch")
+        '(("**;*.*.*" "/usr/local/doc/**/*"))))
 
 ;; Trivial merge.

trunk/abcl/test/lisp/abcl/wild-pathnames.lisp

@@ -51 +51 @@
 
 (deftest wild-pathnames.2
-    (equal 
-     (first (with-test-directories
-                (directory (make-pathname :directory (pathname-directory *temp-directory-root*)
-                                          :name :wild :type "ext"
-                                          :version :newest))))
-     (merge-pathnames *temp-directory-root* "foo.ext"))
+    (check-namestring
+     (namestring (first (with-test-directories
+                            (directory (make-pathname :directory (pathname-directory *temp-directory-root*)
+                                                      :name :wild :type "ext"
+                                                      :version :newest)))))
+     (namestring (merge-pathnames *temp-directory-root* "foo.ext")))
   t)