[armedbear-cvs] r11599 - in trunk/abcl: . test/lisp/abcl test/lisp/ansi
Mark Evenson
mevenson at common-lisp.net
Thu Jan 29 16:00:11 UTC 2009
Author: mevenson
Date: Thu Jan 29 16:00:07 2009
New Revision: 11599
Log:
Use HANDLER-CASE for ANSI tests to quit invoking Lisp if an error in generated.
Further incremental work on ABCL-TEST-LISP (aka the internal ABCL
tests) necessitated by the fact that both it and the ANSI tests use
the REGRESSION-TEST framework which doesn't work well in the same Lisp
instances. Trying to repackage this correctly, but it needs more work.
Modified:
trunk/abcl/abcl.asd
trunk/abcl/test/lisp/abcl/compiler-tests.lisp
trunk/abcl/test/lisp/abcl/condition-tests.lisp
trunk/abcl/test/lisp/abcl/file-system-tests.lisp
trunk/abcl/test/lisp/abcl/java-tests.lisp
trunk/abcl/test/lisp/abcl/math-tests.lisp
trunk/abcl/test/lisp/abcl/misc-tests.lisp
trunk/abcl/test/lisp/abcl/pathname-tests.lisp
trunk/abcl/test/lisp/abcl/rt-package.lisp
trunk/abcl/test/lisp/abcl/rt.lisp
trunk/abcl/test/lisp/abcl/test-utilities.lisp
trunk/abcl/test/lisp/ansi/ansi-tests-compiled.lisp
trunk/abcl/test/lisp/ansi/ansi-tests-interpreted.lisp
trunk/abcl/test/lisp/ansi/package.lisp
Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd (original)
+++ trunk/abcl/abcl.asd Thu Jan 29 16:00:07 2009
@@ -1,23 +1,13 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP -*-
;;; $Id$
-;;;; To run:
-;;;;
-#|
-cmd$ abcl
-CL-USER(1): (progn (require 'asdf)
- (asdf:oos 'asdf:load-op :abcl)
- (asdf:oos 'asdf:test-op :ansi-test-compiled :force t))
-|#
-
(require 'asdf)
(defpackage :abcl-asdf
(:use :cl :asdf))
(in-package :abcl-asdf)
;;; Wrapper for all ABCL ASDF definitions.
-(defsystem :abcl
- :version "0.3.0")
+(defsystem :abcl :version "0.3.0")
(defmethod perform :after ((o load-op) (c (eql (find-system 'abcl))))
;;; Additional test suite loads would go here.
@@ -25,61 +15,49 @@
(defmethod perform ((o test-op) (c (eql (find-system 'abcl))))
;;; Additional test suite invocations would go here.
- (asdf:oos 'asdf:test-op :ansi-test-compiled :force t))
+ (asdf:oos 'asdf:test-op :ansi-compiled :force t))
;;; A collection of test suites for ABCL.
(defsystem :test-abcl
:version "0.3"
- :depends-on (:ansi-test-compiled :abcl-tests))
+ :depends-on (:ansi-compiled #+nil :abcl-tests))
(defmethod perform :after ((o load-op) (c (eql (find-system 'test-abcl))))
#+nil (asdf:oos 'asdf:test-op :cl-bench :force t)
- #+nil (asdf:oos 'asdf:test-op :abcl-tests :force t)
- #+nil (asdf:oos 'asdf:test-op :ansi-test-interpreted :force t)
- (asdf:oos 'asdf:load-op :ansi-test-compiled :force t))
+ (asdf:oos 'asdf:load-op :abcl-test-lisp :force t)
+ (asdf:oos 'asdf:load-op :ansi-compiled :force t)
+ (asdf:oos 'asdf:load-op :ansi-interpreted :force t))
-(defsystem :ansi-test :version "0.1" :components
+(defsystem :ansi-test :version "1.0" :components
;;; GCL ANSI test suite.
((:module ansi-tests :pathname "test/lisp/ansi/" :components
((:file "package")))))
-(defsystem :ansi-test-interpreted :version "0,1" :depends-on (ansi-test))
-(defsystem :ansi-test-compiled :version "0.1" :depends-on (ansi-test))
-(defsystem :abcl-tests
- :version "1.0"
- :components
- ((:module rt :serial t :pathname "test/lisp/abcl/" :components
- ((:file "rt-package") (:file "rt") (:file "test-utilities")))
- (:module tests :depends-on (rt)
- :pathname "test/lisp/abcl/" :components
- ((:file "compiler-tests")
- (:file "condition-tests")
- (:file "file-system-tests")
- #+nil (:file "math-tests")
- (:file "java-tests")
- (:file "misc-tests")
- (:file "pathname-tests")))))
-
- (defmethod perform ((o test-op) (c (eql (find-system 'abcl-tests))))
- "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-tests :force t)."
+(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 'do-tests) :test)))
-
-(defmethod perform ((o test-op) (c (eql (find-system 'ansi-test-interpreted))))
- "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-tests :force t)."
- ;;; FIXME needs ASDF:OOS to be invoked with :FORCE t
- (funcall (intern (symbol-name 'run) :abcl.tests.ansi-tests)
+ (funcall (intern (symbol-name 'run) :ansi.test.ansi)
:compile-tests nil))
-(defmethod perform ((o test-op) (c (eql (find-system 'ansi-test-compiled))))
- "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-test-compiled :force t)."
- (funcall (intern (symbol-name 'run) :abcl.tests.ansi-tests)
+(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))
+(defsystem :abcl-test-lisp :version "1.0" :components
+ ((:module package :pathname "test/lisp/abcl/" :components
+ ((:file "package")))))
+(defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
+ "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-tests :force t)."
+ ;;; FIXME needs ASDF:OOS to be invoked with :FORCE t
+ (funcall (intern (symbol-name 'run) :abcl.test.lisp)))
+
;;; Build ABCL from a Lisp.
+;;; aka the "Lisp-hosted build system"
;;; Works for: abcl, sbcl, clisp, cmu, lispworks, allegro, openmcl
-(defsystem :build-abcl
- :components
+(defsystem :build-abcl :components
((:module build :pathname "" :components
((:file "build-abcl")
(:file "customizations" :depends-on ("build-abcl"))))))
Modified: trunk/abcl/test/lisp/abcl/compiler-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/compiler-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/compiler-tests.lisp Thu Jan 29 16:00:07 2009
@@ -20,9 +20,7 @@
#+abcl
(require '#:jvm)
-(load (merge-pathnames "test-utilities.lisp" *load-truename*))
-
-(in-package #:test)
+(in-package #:abcl.test.lisp)
(defconstant most-positive-java-long 9223372036854775807)
(defconstant most-negative-java-long -9223372036854775808)
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 Thu Jan 29 16:00:07 2009
@@ -18,7 +18,7 @@
(load (merge-pathnames "test-utilities.lisp" *load-truename*))
-(in-package #:test)
+(in-package #:abcl.test.lisp)
(defun filter (string)
"If STRING is unreadable, return \"#<>\"; otherwise return STRING unchanged."
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 Thu Jan 29 16:00:07 2009
@@ -19,9 +19,7 @@
#+sbcl
(require '#:sb-posix)
-(load "test-utilities.lisp")
-
-(in-package #:test)
+(in-package #:abcl.test.lisp)
(export '(pathnames-equal-p run-shell-command copy-file make-symbolic-link
touch make-temporary-directory delete-directory-and-files))
Modified: trunk/abcl/test/lisp/abcl/java-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/java-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/java-tests.lisp Thu Jan 29 16:00:07 2009
@@ -17,12 +17,10 @@
;;; 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)
-(in-package #:test)
-
-#+abcl
-(use-package '#:java)
+;#+abcl
+;(use-package '#:java)
#+allegro
(require :jlinker)
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 Thu Jan 29 16:00:07 2009
@@ -19,9 +19,7 @@
;;; Some of these tests are based on tests in the CLISP test suite.
-(load "test-utilities.lisp")
-
-(in-package #:test)
+(in-package #:abcl.test.lisp)
#+(or abcl cmu sbcl)
(defmacro set-floating-point-modes (&rest args)
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 Thu Jan 29 16:00:07 2009
@@ -17,9 +17,7 @@
;;; 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 #:test)
+(in-package #:abcl.test.lisp)
(deftest dotimes.1
(progn
Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/pathname-tests.lisp (original)
+++ trunk/abcl/test/lisp/abcl/pathname-tests.lisp Thu Jan 29 16:00:07 2009
@@ -17,9 +17,7 @@
;;; 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 #:test)
+(in-package #:abcl.test.lisp)
(defun check-physical-pathname (pathname expected-directory expected-name expected-type)
(let* ((directory (pathname-directory pathname))
Modified: trunk/abcl/test/lisp/abcl/rt-package.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/rt-package.lisp (original)
+++ trunk/abcl/test/lisp/abcl/rt-package.lisp Thu Jan 29 16:00:07 2009
@@ -26,10 +26,10 @@
#:disable-note
))
|#
- (let* ((name (symbol-name :regression-test))
+ (let* ((name (symbol-name :abcl-regression-test))
(pkg (find-package name)))
(unless pkg (setq pkg (make-package name
- :nicknames (mapcar #'symbol-name '(:rtest #-lispworks :rt))
+ :nicknames (mapcar #'symbol-name '(:abcl-rtest #-lispworks :abcl-rt))
:use '(#-wcl :cl #+wcl :lisp)
)))
(let ((*package* pkg))
Modified: trunk/abcl/test/lisp/abcl/rt.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/rt.lisp (original)
+++ trunk/abcl/test/lisp/abcl/rt.lisp Thu Jan 29 16:00:07 2009
@@ -24,7 +24,7 @@
;This was the December 19, 1990 version of the regression tester, but
;has since been modified.
-(in-package :regression-test)
+(in-package :abcl-regression-test)
(declaim (ftype (function (t) t) get-entry expanded-eval do-entries))
(declaim (type list *entries*))
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 Thu Jan 29 16:00:07 2009
@@ -24,18 +24,15 @@
#+(and lispworks win32)
(pushnew :windows *features*)
-(unless (member "RT" *modules* :test #'string=)
+(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*))
;; Force compilation to avoid fasl name conflict between SBCL and
;; Allegro.
#-abcl (compile-file (merge-pathnames "rt.lisp" *load-truename*)))
- (provide "RT"))
+ (provide "ABCL-RT"))
-(unless (find-package '#:test)
- (defpackage #:test (:use #:cl #:regression-test)))
-
-(in-package #:regression-test)
+(in-package #:abcl-regression-test)
(export '(signals-error))
@@ -45,6 +42,6 @@
(condition (c) (typep c ,error-name))
(:no-error (&rest ignored) (declare (ignore ignored)) nil))))
-(rem-all-tests)
+#+nil (rem-all-tests)
-(setf *expected-failures* nil)
+#+nil (setf *expected-failures* nil)
Modified: trunk/abcl/test/lisp/ansi/ansi-tests-compiled.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/ansi-tests-compiled.lisp (original)
+++ trunk/abcl/test/lisp/ansi/ansi-tests-compiled.lisp Thu Jan 29 16:00:07 2009
@@ -1,6 +1,10 @@
(require 'asdf)
-(asdf:oos 'asdf:load-op :abcl)
-(asdf:oos 'asdf:load-op :test-abcl)
-(asdf:oos 'asdf:load-op :ansi-abcl-compiled :force t)
-(asdf:oos 'asdf:test-op :ansi-test-compiled :force t)
-(ext:exit)
\ No newline at end of file
+(handler-case
+ (progn
+ (asdf:oos 'asdf:load-op :abcl :force t)
+ (asdf:oos 'asdf:test-op :ansi-compiled :force t))
+ (t (e) (warn "Exiting after catching ~A" e)))
+(ext:exit)
+
+
+
Modified: trunk/abcl/test/lisp/ansi/ansi-tests-interpreted.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/ansi-tests-interpreted.lisp (original)
+++ trunk/abcl/test/lisp/ansi/ansi-tests-interpreted.lisp Thu Jan 29 16:00:07 2009
@@ -1,5 +1,10 @@
(require 'asdf)
-(asdf:oos 'asdf:load-op :abcl)
-(asdf:oos 'asdf:load-op :test-abcl)
-(asdf:oos 'asdf:test-op :ansi-test-interpreted :force t)
+(handler-case
+ (progn
+ (asdf:oos 'asdf:load-op :abcl :force t)
+ (asdf:oos 'asdf:test-op :ansi-interpreted :force t))
+ (t (e) (warn "Exiting after catching ~A" e)))
(ext:exit)
+
+
+
Modified: trunk/abcl/test/lisp/ansi/package.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/package.lisp (original)
+++ trunk/abcl/test/lisp/ansi/package.lisp Thu Jan 29 16:00:07 2009
@@ -1,9 +1,9 @@
-(defpackage :abcl.tests.ansi-tests
+(defpackage :abcl.test.ansi
(:use :cl :asdf)
- (:nicknames "ansi-tests" "abcl-ansi-tests")
+ (:nicknames "ansi-tests" "abcl-ansi-tests" "gcl-ansi")
(:export :run))
-(in-package :abcl.tests.ansi-tests)
+(in-package :abcl.test.ansi)
(defparameter *ansi-tests-master-source-location*
"<svn://common-lisp.net/project/ansi-test/svn/trunk/ansi-tests>")
@@ -14,26 +14,26 @@
(asdf:component-pathname (asdf:find-system :abcl))))
(defun run (&key (compile-tests nil))
- "Run the ANSI-TESTS suite, found in *ANSI-TESTS-DIRECTORY*.
+ "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."
- (let* ((original-pathname-defaults *default-pathname-defaults*)
- (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)))
+ (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)))
(handler-case
- (progn
- (setf *default-pathname-defaults*
- (merge-pathnames ansi-tests-directory
- *default-pathname-defaults*))
+ (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))
(if (find :unix *features*)
(run-shell-command "cd ~A; make clean" ansi-tests-directory)
- ;; XXX -- what to invoke on win32? Please verify
+ ;; XXX -- what to invoke on win32? Untested:
(run-shell-command
- (format nil ("~A~%~A")
+ (format nil "~A~%~A"
(format nil "cd ~A" *ansi-tests-directory*)
(format nil "erase *.cls *.abcl"))))
(time (load boot-file))
@@ -46,8 +46,8 @@
To resolve, please locally obtain ~A,
and set the value of *ANSI-TESTS-DIRECTORY* to that location."
ansi-tests-directory e
- *ansi-tests-master-source-location*))))
- (setf *default-pathname-defaults* original-pathname-defaults)))
+ *ansi-tests-master-source-location*))))))
+
More information about the armedbear-cvs
mailing list