From: Gary K. <gw...@me...> - 2007-06-02 02:42:07
|
The following bits are meant to make the ASDF test suite more robust in the face of errors and failures. The suite takes more trouble to setup an environment where errors will be caught; prints somewhat nicer error messages and tries to make it easier to add more Lisps (sbcl, clisp and allegro alisp are the only supported ones right now) (and I haven't tested clisp). Please let me know what you think and how you feel. If the consensus is that this is a good step, I'll commit sometime next week. ;;;;; New file ;;;;; test/compile-asdf.lisp (in-package #:common-lisp-user) (load "test/script-support.lisp") (cond ((probe-file "asdf.lisp") (multiple-value-bind (result warnings-p errors-p) (compile-file "asdf.lisp") (declare (ignore result)) (cond (warnings-p (leave-lisp "Testuite failed: ASDF compiled with warnings" 1)) (errors-p (leave-lisp "Testuite failed: ASDF compiled with ERRORS" 2)) (t (leave-lisp "ASDF compiled cleanly" 0))))) (t (leave-lisp "Testsuite failed: unable to find ASDF source" 3))) ;;;;; New file ;;;;; test/script-support.lisp (in-package #:common-lisp-user) ;;; Code adapted from cl-launch (any errors in transcription are mine!) ;; http://www.cliki.net/cl-launch (defun leave-lisp (message return) (when message (format *error-output* message)) #+allegro (excl:exit return) #+clisp (ext:quit return) #+(or cmu scl) (unix:unix-exit code) #+ecl (si:quit return) #+gcl (lisp:quit code) #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore- errors-p t) #+(or openmcl mcl) (ccl::quit return) #+sbcl (sb-ext:quit :unix-status return) (error "Don't know how to quit Lisp; wanting to use exit code ~a" return)) (defmacro exit-on-error (&body body) `(handler-case (progn ,@body (leave-lisp "Script succeeded" 0)) (error (c) (format *error-output* "~a" c) (leave-lisp "Script failed" 1)))) ;;;;;;; Changes Index: test/run-tests.sh =================================================================== RCS file: /cvsroot/cclan/asdf/test/run-tests.sh,v retrieving revision 1.9 diff -u -w -u -r1.9 run-tests.sh --- test/run-tests.sh 21 Mar 2007 22:08:34 -0000 1.9 +++ test/run-tests.sh 2 Jun 2007 02:39:06 -0000 @@ -4,19 +4,38 @@ do_tests() { rm *.$2 || true -( cd .. && echo '(compile-file "asdf")' |$1 ) +( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 ) +if [ $? -eq 0 ] ; then + test_count=0 + test_pass=0 + test_fail=0 + failed_list="" for i in *.script; do + echo "Testing: $i" >&2 + test_count=`expr "$test_count" + 1` rm *.$2 || true if $1 < $i ;then echo "Using $1, $i passed" >&2 + test_pass=`expr "$test_pass" + 1` else echo "Using $1, $i failed" >&2 + test_fail=`expr "$test_fail" + 1` + failed_list="$failed_list $i" sok=0 - exit 1 fi done -echo "Using $1, all tests apparently successful ($sok)" >&2 + echo >&2 + echo "Using $1" >&2 + echo "Ran $test_count tests: " >&2 + echo " $test_pass passing and $test_fail failing" >&2 + if [ $test_fail -eq 0 ] ; then + echo "all tests apparently successful" >&2 + else + echo "failing test(s): $failed_list" >&2 + fi + echo >&2 +fi } # do_tests {lisp invocation} {fasl extension} @@ -24,19 +43,43 @@ # - quit with exit status 0 on getting eof # - quit with exit status >0 if an unhandled error occurs +# terminate on error set -e -if type sbcl -then - do_tests "sbcl --userinit /dev/null --sysinit /dev/null -- noprogrammer" fasl +lisp=$1 +if [ -z $1 ] ; then + lisp="sbcl" fi -if [ -x /usr/bin/lisp ] -then - do_tests "/usr/bin/lisp -batch -noinit" x86f +if [ "$lisp" = "sbcl" ] ; then + if type sbcl ; then + fasl_ext="fasl" + command="sbcl --userinit /dev/null --sysinit /dev/null -- noprogrammer" + fi +elif [ "$lisp" = "clisp" ] ; then + if type clisp ; then + fasl_ext="fas" + command=`where clisp` + command="$command -norc -ansi -I - " + fi +elif [ "$lisp" = "allegro" ] ; then + if type alisp ; then + fasl_ext="fasl" + command="alisp -q --batch " + fi fi -if [ -x /usr/bin/clisp ] -then - do_tests "/usr/bin/clisp -norc -ansi -I - " fas + +#if [ -x /usr/bin/lisp ] +#then +# do_tests "/usr/bin/lisp -batch -noinit" x86f +#fi + + +if [ -z "$command" ] ; then + echo "Error: don't know how to run Lisp named $lisp" +else + echo $command + do_tests "$command" $fasl_ext fi + Index: test/test-force.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test-force.script,v retrieving revision 1.1 diff -u -w -u -r1.1 test-force.script --- test/test-force.script 30 May 2006 18:14:40 -0000 1.1 +++ test/test-force.script 2 Jun 2007 02:39:06 -0000 @@ -1,5 +1,7 @@ ;;; -*- Lisp -*- +(load "script-support") (load "../asdf") +(exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'test-force) @@ -14,3 +16,4 @@ (sleep 1) (asdf:operate 'asdf:load-op 'test-force :force t) (assert (> (file-write-date (compile-file-pathname "file1")) file1- date)) + ) \ No newline at end of file Index: test/test-package.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test-package.script,v retrieving revision 1.1 diff -u -w -u -r1.1 test-package.script --- test/test-package.script 21 Aug 2006 10:52:34 -0000 1.1 +++ test/test-package.script 2 Jun 2007 02:39:06 -0000 @@ -1,5 +1,8 @@ (in-package :cl-user) +;;; -*- Lisp -*- +(load "script-support") (load "../asdf") +(exit-on-error (defun module () 1) @@ -8,3 +11,4 @@ (defclass module () ()) (load "test-package.asd") +) Index: test/test-preferences-1.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test-preferences-1.script,v retrieving revision 1.1 diff -u -w -u -r1.1 test-preferences-1.script --- test/test-preferences-1.script 6 Jul 2006 02:26:00 -0000 1.1 +++ test/test-preferences-1.script 2 Jun 2007 02:39:06 -0000 @@ -1,9 +1,11 @@ ;;; -*- Lisp -*- - +(load "script-support") (load "../asdf") +(exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (in-package :asdf) (asdf:oos 'asdf:load-op 'test-preferences-system-1) (assert (eq common-lisp-user::*test-preferences-variable-1* :load)) (asdf:oos 'asdf:test-op 'test-preferences-system-1) (assert (eq common-lisp-user::*test-preferences-variable-1* :test)) + ) \ No newline at end of file Index: test/test-version.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test-version.script,v retrieving revision 1.1 diff -u -w -u -r1.1 test-version.script --- test/test-version.script 14 May 2006 16:03:16 -0000 1.1 +++ test/test-version.script 2 Jun 2007 02:39:06 -0000 @@ -1,5 +1,5 @@ -;; -*- lisp -*- - +;;; -*- Lisp -*- +(load "script-support") (load "../asdf") (setf asdf:*central-registry* '(*default-pathname-defaults*)) @@ -8,6 +8,7 @@ (in-package :test-version-system) +(cl-user::exit-on-error (defsystem :versioned-system-1 :pathname #.*default-pathname-defaults* :version "1.0") @@ -27,4 +28,4 @@ (test :versioned-system-2 "1.0") (test :versioned-system-3 "2.0" nil)) - \ No newline at end of file + ) \ No newline at end of file Index: test/test1.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test1.script,v retrieving revision 1.3 diff -u -w -u -r1.3 test1.script --- test/test1.script 4 Feb 2003 17:01:27 -0000 1.3 +++ test/test1.script 2 Jun 2007 02:39:06 -0000 @@ -1,15 +1,18 @@ ;;; -*- Lisp -*- +(load "script-support") (load "../asdf") +(exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'test1) ;; test that it compiled (defvar file1-date (file-write-date (compile-file-pathname "file1"))) -(assert (and file1-date (file-write-date (compile-file-pathname "file2")))) + (assert (and file1-date (file-write-date (compile-file-pathname "file2"))))) ;; and loaded (assert test-package::*file1*) +(exit-on-error ;; now remove one output file and check that the other is _not_ ;; recompiled (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines @@ -30,3 +33,4 @@ (sleep 1) (asdf:operate 'asdf:load-op 'test1) (assert (> (file-write-date (compile-file-pathname "file2")) before))) + ) \ No newline at end of file Index: test/test2.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test2.script,v retrieving revision 1.3 diff -u -w -u -r1.3 test2.script --- test/test2.script 20 Sep 2002 12:41:42 -0000 1.3 +++ test/test2.script 2 Jun 2007 02:39:06 -0000 @@ -1,5 +1,7 @@ ;;; -*- Lisp -*- +(load "script-support") (load "../asdf") +(exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) ;(trace asdf::perform) ;(trace asdf::find-component) @@ -17,3 +19,4 @@ (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) (:no-error (c) (error "should have failed, oops"))) + ) \ No newline at end of file Index: test/test3.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test3.script,v retrieving revision 1.3 diff -u -w -u -r1.3 test3.script --- test/test3.script 20 Sep 2002 12:41:42 -0000 1.3 +++ test/test3.script 2 Jun 2007 02:39:06 -0000 @@ -1,12 +1,14 @@ ;;; -*- Lisp -*- #+(or f1 f2) (error "This test cannot run if :f1 or :f2 are on *features*") +(load "script-support") (load "../asdf") +(in-package :asdf) +(cl-user::exit-on-error (asdf:run-shell-command "rm ~A ~A" (namestring (compile-file-pathname "file1")) (namestring (compile-file-pathname "file2"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) -(in-package :asdf) (handler-case (asdf:oos 'asdf:load-op 'test3) (asdf:missing-dependency (c) @@ -21,3 +23,4 @@ (asdf:oos 'asdf:load-op 'test3) (assert (probe-file (compile-file-pathname "file2"))) (assert (not (probe-file (compile-file-pathname "file1")))) + ) Index: test/test4.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/test4.script,v retrieving revision 1.1 diff -u -w -u -r1.1 test4.script --- test/test4.script 20 May 2002 14:16:46 -0000 1.1 +++ test/test4.script 2 Jun 2007 02:39:06 -0000 @@ -1,8 +1,12 @@ ;;; -*- Lisp -*- +;;; -*- Lisp -*- +(load "script-support") (load "../asdf") -(setf asdf:*central-registry* '(*default-pathname-defaults*)) (in-package :asdf) +(cl-user::exit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) (assert (not (component-property (find-system 'test3) :foo))) (assert (equal (component-property (find-system 'test3) :prop1) "value")) (setf (component-property (find-system 'test3) :foo) "bar") (assert (equal (component-property (find-system 'test3) :foo) "bar")) + ) \ No newline at end of file Index: test/wild-module.script =================================================================== RCS file: /cvsroot/cclan/asdf/test/wild-module.script,v retrieving revision 1.2 diff -u -w -u -r1.2 wild-module.script --- test/wild-module.script 8 Feb 2003 15:31:17 -0000 1.2 +++ test/wild-module.script 2 Jun 2007 02:39:06 -0000 @@ -1,7 +1,11 @@ ;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(exit-on-error (load "../asdf") (load "../wild-modules") (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'wild-module) + ) \ No newline at end of file -- Gary Warren King, metabang.com Cell: (413) 885 9127 Fax: (206) 338-4052 gwkkwg on Skype * garethsan on AIM |