From 714373002f83089c2fe4d2ab7a975c9b7c886f1c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Thu, 4 Feb 2010 13:21:43 -0500 Subject: [PATCH] ASDF 1.602: pass more tests. * made it easier to debug tests. export DEBUG_ASDF_TEST=t * add ECL support to tests: passes all 18 scripts, but have to ignore compile warnings. * lots of whitespace issues, including ones that made .gitignore not work! --- .gitignore | 7 +-- asdf.lisp | 17 +++--- test/compile-asdf.lisp | 6 +- test/dweinreb-tests.lisp | 16 +++--- test/graveyard/test-preferences-1.script | 2 +- test/graveyard/test-preferences-system-1.asd | 12 ++-- test/graveyard/test6.script | 8 +-- test/graveyard/test7.script | 8 +-- test/in-progress.lisp | 4 +- test/run-tests.sh | 58 ++++++++++++++------ test/script-support.lisp | 11 +++- test/static-and-serial.asd | 2 +- test/test-module-pathnames.script | 12 ++-- test/test-nested-components-1.asd | 14 ++--- test/test-nested-components.script | 10 ++-- test/test-package.script | 9 +-- test/test-retry-loading-component-1.script | 15 +++-- test/test-source-registry.s | 2 +- test/test-touch-system-1.script | 2 +- test/test-touch-system-2.script | 2 +- test/test-try-recompiling-1.script | 6 +- test/test-version.script | 2 +- test/test1.asd | 2 +- test/test2.script | 8 ++- test/test2b1.asd | 2 - test/test3.script | 4 +- test/test4.script | 2 +- test/test5.not-implemented | 2 +- test/test8.script | 4 +- test/test9.script | 6 +- 30 files changed, 144 insertions(+), 111 deletions(-) diff --git a/.gitignore b/.gitignore index c81e48de..a4a40c84 100644 --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,6 @@ test/conf.d/ test/dir1/ test/dir2/ - # We build these at various stages in the make process LICENSE website/output/ @@ -21,9 +20,9 @@ tmp/ lift-local.config *.dribble *.fasl -*.dfsl -*.cfsl -*.fas +*.dfsl +*.cfsl +*.fas *.lib *.o *.*fsl diff --git a/asdf.lisp b/asdf.lisp index e03b06da..4791a58b 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -63,7 +63,7 @@ (let ((sym (find-symbol "*ASDF-REVISION*" asdf))) (when sym (unexport sym asdf) - (unintern sym)))))) + (unintern sym asdf)))))) #+ecl (require 'cmp) @@ -187,7 +187,7 @@ ;;;; (defparameter *asdf-version* ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.601" (1+ (length "VERSION")))) + (subseq "VERSION:1.602" (1+ (length "VERSION")))) (defun asdf-version () *asdf-version*) @@ -679,7 +679,7 @@ and NIL NAME and TYPE components" ;;; what about VERSION??? (defun component-parent-pathname (component) (aif (component-parent component) (component-pathname it) - *default-pathname-defaults*)) + (truename *default-pathname-defaults*))) (defmethod component-relative-pathname ((component module)) (or (slot-value component 'relative-pathname) @@ -690,8 +690,8 @@ and NIL NAME and TYPE components" ;;; what about VERSION??? :host (pathname-host (component-parent-pathname component)))))) (defmethod component-pathname ((component component)) - (let ((*default-pathname-defaults* (component-parent-pathname component))) - (merge-pathnames (component-relative-pathname component)))) + (merge-pathnames (component-relative-pathname component) + (component-parent-pathname component))) (defmethod component-property ((c component) property) (cdr (assoc property (slot-value c 'properties) :test #'equal))) @@ -932,6 +932,7 @@ to `~a` which is not a directory.~@:>" ;;; a component with no parent is a system (defmethod find-component ((module (eql nil)) name &optional version) + (declare (ignorable module)) (let ((m (find-system name nil))) (if (and m (version-satisfies m version)) m))) @@ -988,7 +989,7 @@ to `~a` which is not a directory.~@:>" (defmethod shared-initialize :after ((operation operation) slot-names &key force &allow-other-keys) - (declare (ignore slot-names force)) + (declare (ignorable operation slot-names force)) ;; empty method to disable initarg validity checking ) @@ -2188,8 +2189,8 @@ with a different configuration, so the configuration would be re-read then." (defmethod process-output-translations ((x null) &key (inherit *default-output-translations*) collect) + (declare (ignorable x)) (inherit-output-translations inherit :collect collect)) - (defmethod process-output-translations ((form cons) &key (inherit *default-output-translations*) collect) @@ -2505,8 +2506,8 @@ with a different configuration, so the configuration would be re-read then." (defmethod process-source-registry ((x null) &key (inherit *default-source-registries*) collect) + (declare (ignorable x)) (inherit-source-registry inherit :collect collect)) - (defmethod process-source-registry ((form cons) &key (inherit *default-source-registries*) collect) diff --git a/test/compile-asdf.lisp b/test/compile-asdf.lisp index 168c189c..33cc9067 100644 --- a/test/compile-asdf.lisp +++ b/test/compile-asdf.lisp @@ -12,11 +12,11 @@ (compile-file "asdf.lisp")) (declare (ignore result)) (cond (warnings-p - (leave-lisp "Testuite failed: ASDF compiled with warnings" 1)) + #-ecl ;;; ECL gives warnings that it shouldn't! + (leave-lisp "Testsuite failed: ASDF compiled with warnings" 1)) (errors-p - (leave-lisp "Testuite failed: ASDF compiled with ERRORS" 2)) + (leave-lisp "Testsuite failed: ASDF compiled with ERRORS" 2)) (t (leave-lisp "ASDF compiled cleanly" 0))))) (t (leave-lisp "Testsuite failed: unable to find ASDF source" 3))) - diff --git a/test/dweinreb-tests.lisp b/test/dweinreb-tests.lisp index ba058555..891f18a6 100644 --- a/test/dweinreb-tests.lisp +++ b/test/dweinreb-tests.lisp @@ -15,7 +15,7 @@ http://ilc2009.scheming.org/ (already-compiled :initarg :already-compiled :reader test-already-compiled) (expected :initarg :expected :reader test-expected))) -(defmacro define-test (test-name system-name +(defmacro define-test (test-name system-name &key operation-name already-compiled expected) `(progn (push ',test-name *all-tests*) @@ -34,7 +34,7 @@ http://ilc2009.scheming.org/ (defmethod asdf:operation-done-p ((o asdf:compile-op) (c test-file)) (declare (ignorable o)) - (member (asdf:component-name c) (test-already-compiled *test*) + (member (asdf:component-name c) (test-already-compiled *test*) :test #'string=)) (defmethod asdf:operation-done-p ((o asdf:operation) (c test-file)) @@ -70,7 +70,7 @@ http://ilc2009.scheming.org/ (first steps) *steps*))) ;(format t "~2%STEPS: ~S~3%" *steps*) (dolist (expectation (test-expected *test*)) - (destructuring-bind (op file &rest at) + (destructuring-bind (op file &rest at) expectation ;(format t "~2%Expectation: ~S~3%" expectation) (check-type file string) @@ -81,8 +81,8 @@ http://ilc2009.scheming.org/ (fail "~S was not ~A" file op) (loop for (relationship file2) on at by #'cddr do (check-type file2 string) - (let* ((op2 (ecase relationship - (:after-loading :loaded) + (let* ((op2 (ecase relationship + (:after-loading :loaded) (:after-compiling :compiled))) (pos2 (position (cons op2 file2) *steps* :test #'equal))) @@ -92,7 +92,7 @@ http://ilc2009.scheming.org/ ((< pos pos2) (fail "Wrong order between ~A of ~S and ~A of ~S" op file op2 file2)))))))) - (:did-not-compile + (:did-not-compile (when (member (cons :compiled file) *steps*) (fail "~A compiled but should not have" file))) (:did-not-load @@ -147,7 +147,7 @@ http://ilc2009.scheming.org/ :operation-name asdf:load-op :already-compiled () :expected ((:compiled "a" :after-compiling "g" :after-compiling "k" - :after-compiling "h" :after-loading "g" + :after-compiling "h" :after-loading "g" :after-loading "k" :after-loading "h") (:loaded "a" :after-compiling "a") (:compiled "b") @@ -213,7 +213,7 @@ http://ilc2009.scheming.org/ (asdf:defsystem system-5 :components ((:test-file "a") (:test-file "b" :depends-on ("a") - :in-order-to ((asdf:compile-op + :in-order-to ((asdf:compile-op (asdf:load-op "a")))))) (define-test test-5 system-5 diff --git a/test/graveyard/test-preferences-1.script b/test/graveyard/test-preferences-1.script index 2e0b245c..f2055eb3 100644 --- a/test/graveyard/test-preferences-1.script +++ b/test/graveyard/test-preferences-1.script @@ -1,7 +1,7 @@ ;;; -*- Lisp -*- (load "script-support") (load "../asdf") -(exit-on-error +(exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (in-package :asdf) (setf asdf::*load-preference-files* t) diff --git a/test/graveyard/test-preferences-system-1.asd b/test/graveyard/test-preferences-system-1.asd index d8f6444a..2a363305 100644 --- a/test/graveyard/test-preferences-system-1.asd +++ b/test/graveyard/test-preferences-system-1.asd @@ -1,7 +1,7 @@ ;;; -*- Lisp -*- (in-package #:common-lisp) -(defpackage #:test-preferences-1-asdf-system +(defpackage #:test-preferences-1-asdf-system (:use #:common-lisp #:asdf)) (in-package #:asdf) @@ -10,23 +10,23 @@ ((:file "test-preferences-1")) :in-order-to ((test-op (load-op test-preferences-system-1)))) -(defmethod operation-done-p +(defmethod operation-done-p ((o test-op) (c (eql (find-system 'test-preferences-system-1)))) (values nil)) (defmethod load-preferences - ((system (eql (find-system 'test-preferences-system-1))) + ((system (eql (find-system 'test-preferences-system-1))) (operation test-op)) - ;; the default load-preferences does nothing for anything other than a + ;; the default load-preferences does nothing for anything other than a ;; basic-load-op. So, ... we hack it (load (make-pathname :name "test-preferences-system-test" :type "lisp" :defaults *default-pathname-defaults*))) -(defmethod preference-file-for-system/operation - ((system (eql (find-system 'test-preferences-system-1))) +(defmethod preference-file-for-system/operation + ((system (eql (find-system 'test-preferences-system-1))) (operation load-op)) (make-pathname :name "test-preferences-system-load" diff --git a/test/graveyard/test6.script b/test/graveyard/test6.script index 5cc6c6d8..59b2b49a 100644 --- a/test/graveyard/test6.script +++ b/test/graveyard/test6.script @@ -9,11 +9,11 @@ (exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (defmethod asdf:preference-file-for-system/operation + (defmethod asdf:preference-file-for-system/operation ((system (eql (asdf:find-system 'test1))) operation) - (merge-pathnames (make-pathname :name "test1" :type "preferences"))) + (merge-pathnames (make-pathname :name "test1" :type "preferences"))) (asdf:operate 'asdf:load-op 'test1) (assert (null *test6*))) - - + + diff --git a/test/graveyard/test7.script b/test/graveyard/test7.script index 5f2e89cf..76c2cc80 100644 --- a/test/graveyard/test7.script +++ b/test/graveyard/test7.script @@ -9,12 +9,12 @@ (exit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (defmethod asdf:preference-file-for-system/operation + (defmethod asdf:preference-file-for-system/operation ((system (eql (asdf:find-system 'test1))) operation) - (merge-pathnames (make-pathname :name "test1" :type "preferences"))) + (merge-pathnames (make-pathname :name "test1" :type "preferences"))) (setf asdf::*load-preference-files* t) (asdf:operate 'asdf:load-op 'test1) (assert (eq *test6* :yes))) - - + + diff --git a/test/in-progress.lisp b/test/in-progress.lisp index fbfd9e88..d04e5e27 100644 --- a/test/in-progress.lisp +++ b/test/in-progress.lisp @@ -5,7 +5,7 @@ (let ((*system-definition-search-functions* '(sysdef-central-registry-search)) (*central-registry* (list "/tmp/ok-1/" "/tmp/bad" "/tmp/ok-2/"))) - (handler-bind + (handler-bind ((error (lambda (c) (when (find-restart 'remove-entry-from-registry) (invoke-restart 'remove-entry-from-registry))))) @@ -19,7 +19,7 @@ (let ((*system-definition-search-functions* '(sysdef-central-registry-search)) (*central-registry* (list "/tmp/ok-1/" "/tmp/bad" "/tmp/ok-2/"))) - (handler-bind + (handler-bind ((error (lambda (c) (when (find-restart 'coerce-entry-to-directory) (invoke-restart 'coerce-entry-to-directory))))) diff --git a/test/run-tests.sh b/test/run-tests.sh index 2ae2dfb7..1cb499ce 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -26,9 +26,11 @@ fi sok=1 do_tests() { -rm -f *.$2 || true -( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 ) -if [ $? -eq 0 ] ; then + command=$1 eval=$2 fasl_ext=$3 + rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true + ( cd .. && $command $eval '(load "test/compile-asdf.lisp")' ) + if [ $? -eq 0 ] ; then + echo "Compiled OK" test_count=0 test_pass=0 test_fail=0 @@ -37,12 +39,12 @@ if [ $? -eq 0 ] ; then do echo "Testing: $i" >&2 test_count=`expr "$test_count" + 1` - rm -f *.$2 || true - if $1 < $i ; then - echo "Using $1, $i passed" >&2 + rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true + if $command $eval "(load \"$i\")" ; then + echo "Using $command, $i passed" >&2 test_pass=`expr "$test_pass" + 1` else - echo "Using $1, $i failed" >&2 + echo "Using $command, $i failed" >&2 test_fail=`expr "$test_fail" + 1` failed_list="$failed_list $i" sok=0 @@ -50,7 +52,7 @@ if [ $? -eq 0 ] ; then done echo >&2 echo "-#---------------------------------------" >&2 - echo "Using $1" >&2 + echo "Using $command" >&2 echo "Ran $test_count tests: " >&2 echo " $test_pass passing and $test_fail failing" >&2 if [ $test_fail -eq 0 ] ; then @@ -60,7 +62,7 @@ if [ $? -eq 0 ] ; then fi echo "-#---------------------------------------" >&2 echo >&2 -fi + fi } # terminate on error @@ -75,23 +77,31 @@ case "$lisp" in sbcl) if type sbcl ; then fasl_ext="fasl" - command="sbcl --userinit /dev/null --sysinit /dev/null --noinform --noprogrammer" + command="sbcl --noinform --userinit /dev/null --sysinit /dev/null" + nodebug="--disable-debugger" + eval="--eval" fi ;; clisp) if type clisp ; then fasl_ext="fas" command=`which clisp` - command="$command -norc -ansi -I - " + command="$command -norc -ansi -I " + nodebug="-on-error exit" + eval="-x" fi ;; allegro) if type alisp ; then fasl_ext="fasl" - command="alisp -q -batch " + command="alisp -q " + nodebug="-batch" + eval="-eval" fi ;; allegromodern) if type mlisp ; then fasl_ext="fasl" - command="mlisp -q -batch " + command="mlisp -q" + nodebug="-batch" + eval="-eval" fi ;; ccl) if type ccl ; then @@ -104,15 +114,30 @@ case "$lisp" in i?86|ppc) fasl_bits=32 ;; esac fasl_ext="${fasl_os}${fasl_bits}fsl" - command="ccl --no-init --quiet --batch " + command="ccl --no-init --quiet" + nodebug="--batch" + eval="--eval" fi ;; cmucl) if type lisp ; then fasl_ext="x86f" - command="lisp -batch -noinit" + command="lisp -noinit" + nodebug="-batch" + eval="-eval" + fi ;; + ecl) + if type ecl ; then + fasl_ext="fas" + command=`which ecl` + command="$command -norc" + eval="-eval" fi ;; esac +if [ -z "${DEBUG_ASDF_TEST}" ] ; then + command="$command $nodebug" +fi + create_asds () { mkdir -p {conf.d,dir1,dir2/{dir3,dir4}} for i in dir1 dir2; do touch "$i"/test.asd; done @@ -131,6 +156,7 @@ else mkdir -p results echo $command thedate=`date "+%Y-%m-%d"` - do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save" + do_tests "$command" "$eval" "$fasl_ext" 2>&1 | \ + tee "results/${lisp}.text" "results/${lisp}-${thedate}.save" clean_up fi diff --git a/test/script-support.lisp b/test/script-support.lisp index 08159881..defb7e37 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -28,9 +28,14 @@ (error "Don't know how to quit Lisp; wanting to use exit code ~a" return)) (defmacro quit-on-error (&body body) - `(handler-case - (progn ,@body + `(call-quitting-on-error (lambda () ,@body))) + +(defun call-quitting-on-error (thunk) + (handler-case + (progn (funcall thunk) (leave-lisp "~&Script succeeded~%" 0)) (error (c) (format *error-output* "~a" c) - (leave-lisp "~&Script failed~%" 1)))) + (if (ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST")) + (break) + (leave-lisp "~&Script failed~%" 1))))) diff --git a/test/static-and-serial.asd b/test/static-and-serial.asd index 5e4e2a61..2e4842aa 100644 --- a/test/static-and-serial.asd +++ b/test/static-and-serial.asd @@ -1,5 +1,5 @@ #| -make sure that serial t and static-files don't cause full rebuilds all +make sure that serial t and static-files don't cause full rebuilds all the time... |# diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script index 310c94aa..20516542 100644 --- a/test/test-module-pathnames.script +++ b/test/test-module-pathnames.script @@ -2,7 +2,7 @@ (load "script-support") (load "../asdf") -(quit-on-error +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:load-system 'test-module-pathnames) (flet ((submodule (module name) @@ -23,7 +23,7 @@ (pathname-foo (asdf:component-relative-pathname static)) '((:relative "level2") "static" "file")) nil - "Didn't get the name of static.file right"))) + "Didn't get the name of static.file right"))) (assert (find-package :test-package) nil "package test-package not found") (assert (find-symbol (symbol-name '*file-tmp*) :test-package) nil @@ -32,8 +32,8 @@ nil "symbol `*file-tmp*` has wrong value") #| ; must be adapted to ABL - (assert (probe-file (merge-pathnames - (make-pathname + (assert (probe-file (merge-pathnames + (make-pathname :name "file1" :type (pathname-type (compile-file-pathname "x")) :directory '(:relative "sources" "level1")))) @@ -47,8 +47,8 @@ #| ; must be adapted to ABL - (assert (probe-file (merge-pathnames - (make-pathname + (assert (probe-file (merge-pathnames + (make-pathname :name "file2" :type (pathname-type (compile-file-pathname "x")) :directory '(:relative "sources" "level1" "level2")))) diff --git a/test/test-nested-components-1.asd b/test/test-nested-components-1.asd index fad0ef4e..5e8b6af5 100644 --- a/test/test-nested-components-1.asd +++ b/test/test-nested-components-1.asd @@ -28,28 +28,28 @@ (in-package #:test-nested-components.system) (defsystem test-nested-components-a - :components + :components ((:module "nested-components" :pathname "" :components ((:file "test-nested-1"))))) (defsystem test-nested-components-b :pathname "" - :components + :components ((:file "test-nested-1"))) (defsystem db-agraph-preflight - :components + :components ((:module "preflight-checks" :components ((:file "preflight"))))) (defsystem db-agraph-preflight-2 :pathname "preflight-checks" - :components + :components ((:file "preflight"))) #| newer traverse always fails -older traverse fails when db-agraph-preflight is evaluated, ok - when loaded or compiled -|# \ No newline at end of file +older traverse fails when db-agraph-preflight is evaluated, ok + when loaded or compiled +|# diff --git a/test/test-nested-components.script b/test/test-nested-components.script index 7e16b5ab..d0eed16e 100644 --- a/test/test-nested-components.script +++ b/test/test-nested-components.script @@ -6,10 +6,10 @@ (load "../asdf") (in-package #:common-lisp-user) -(quit-on-error +(quit-on-error (setf asdf:*central-registry* nil) (load (merge-pathnames "test-nested-components-1.asd")) - (print + (print (list :a (asdf::traverse (make-instance 'asdf:compile-op) @@ -28,7 +28,7 @@ (asdf:oos 'asdf:compile-op 'test-nested-components-a) (asdf:oos 'asdf:compile-op 'test-nested-components-b) - (print + (print (list (asdf::traverse (make-instance 'asdf:load-op) (asdf:find-system 'test-nested-components-a)) @@ -56,7 +56,7 @@ . #<ASDF:MODULE "preflight-checks" {11B799A9}>) (#<ASDF:LOAD-OP NIL {11D04FE9}> . #<ASDF:SYSTEM "test-nested-components-a" {11AEDD59}>)) - + ((#<ASDF:COMPILE-OP NIL {11E4D9B1}> . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>) (#<ASDF:COMPILE-OP NIL {11E4D9B1}> @@ -65,4 +65,4 @@ . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>) (#<ASDF:LOAD-OP NIL {11E4A911}> . #<ASDF:SYSTEM "test-nested-components-b" {11C92819}>))) -|# \ No newline at end of file +|# diff --git a/test/test-package.script b/test/test-package.script index 7fe534d6..7a2031fa 100644 --- a/test/test-package.script +++ b/test/test-package.script @@ -1,14 +1,9 @@ -(in-package :cl-user) ;;; -*- Lisp -*- +(in-package :cl-user) (load "script-support") (load "../asdf") (quit-on-error - (defun module () 1) - (load "test-package.asd") - (defclass module () ()) - - (load "test-package.asd") -) + (load "test-package.asd")) diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 0975bb1a..e322be2a 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -9,25 +9,30 @@ ;#+allegro ;(trace excl.osi:command-output) (defvar *caught-error* nil) -(quit-on-error +(quit-on-error + (format t "trlc1 1~%") (when (probe-file "try-reloading-dependency.asd") (asdf:run-shell-command "rm -f ~A" (namestring "try-reloading-dependency.asd"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf::*defined-systems* (asdf::make-defined-systems-table)) - (handler-bind ((error (lambda (c) + (format t "trlc1 2~%") + (handler-bind ((error (lambda (c) (format t "~&Caught error ~s" c) (setf *caught-error* t) (asdf:run-shell-command "cp try-reloading-dependency.hidden try-reloading-dependency.asd") + (format t "trlc1 5~%") (multiple-value-bind (name mode) (find-symbol (symbol-name 'retry) :asdf) (assert (eq mode :external) nil "Mode of ~s was not external" name) + (format t "trlc1 6~%") (let ((restart (find-restart name c))) + (format t "trlc1 7~%") (assert restart) (format t "~&restart: ~S~&" restart) (when restart (invoke-restart restart))))))) + (format t "trlc1 3~%") (asdf:oos 'asdf:load-op 'try-reloading-1)) - (assert *caught-error*) - ) - + (format t "trlc1 4~%") + (assert *caught-error*)) diff --git a/test/test-source-registry.s b/test/test-source-registry.s index 61ce457a..51b34821 100644 --- a/test/test-source-registry.s +++ b/test/test-source-registry.s @@ -12,7 +12,7 @@ (merge-pathnames path defaults)) (defun ensure-recursive-directory (path) - (concatenate + (concatenate 'string (namestring (ensure-directory-pathname path)) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index 0ddeefd5..178760d4 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -5,7 +5,7 @@ (load "script-support") (load "../asdf") -(quit-on-error +(quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) (when data diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script index 82717fba..5657fd6a 100644 --- a/test/test-touch-system-2.script +++ b/test/test-touch-system-2.script @@ -5,7 +5,7 @@ (load "script-support") (load "../asdf") -(quit-on-error +(quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) (when data diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script index 9dbc9a97..fe71158d 100644 --- a/test/test-try-recompiling-1.script +++ b/test/test-try-recompiling-1.script @@ -6,12 +6,12 @@ (load "../asdf") (defvar *caught-error* nil) -(quit-on-error +(quit-on-error (asdf:run-shell-command "rm -f ~A" - (namestring + (namestring (compile-file-pathname "try-recompiling-1"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (handler-bind ((error (lambda (c) + (handler-bind ((error (lambda (c) (setf *caught-error* t) (multiple-value-bind (name mode) (find-symbol diff --git a/test/test-version.script b/test/test-version.script index 783cec88..071f67d5 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -8,7 +8,7 @@ (in-package :test-version-system) -(cl-user::quit-on-error +(cl-user::quit-on-error (defsystem :versioned-system-1 :pathname #.*default-pathname-defaults* :version "1.0") diff --git a/test/test1.asd b/test/test1.asd index 6d50d3c1..b1d7bff0 100644 --- a/test/test1.asd +++ b/test/test1.asd @@ -1,5 +1,5 @@ ;;; -*- Lisp -*- -(asdf:defsystem test1 +(asdf:defsystem test1 :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) (:file "file1"))) diff --git a/test/test2.script b/test/test2.script index 39e2b2ec..046b029f 100644 --- a/test/test2.script +++ b/test/test2.script @@ -2,13 +2,16 @@ (load "script-support") (load "../asdf") (quit-on-error + (format t "test2 1~%") (setf asdf:*central-registry* '(*default-pathname-defaults*)) ;(trace asdf::perform) ;(trace asdf::find-component) ;(trace asdf::traverse) (asdf:oos 'asdf:load-op 'test2b1) - (assert (and (probe-file (asdf:compile-file-pathname* "file3")) - (probe-file (asdf:compile-file-pathname* "file4")))) + (format t "test2 2~%") + (assert (and (probe-file (asdf:compile-file-pathname* (truename "file3.lisp"))) + (probe-file (asdf:compile-file-pathname* (truename "file4.lisp"))))) + (format t "test2 3~%") (handler-case (asdf:oos 'asdf:load-op 'test2b2) (asdf:missing-dependency (c) @@ -16,6 +19,7 @@ (:no-error (c) (declare (ignore c)) (error "should have failed, oops"))) + (format t "test2 4~%") (handler-case (asdf:oos 'asdf:load-op 'test2b3) (asdf:missing-dependency (c) diff --git a/test/test2b1.asd b/test/test2b1.asd index 21b8fc09..bc94d5d9 100644 --- a/test/test2b1.asd +++ b/test/test2b1.asd @@ -4,5 +4,3 @@ :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")))) (:file "file1")) :in-order-to ((load-op (load-op (version test2a "1.1"))))) - - diff --git a/test/test3.script b/test/test3.script index 8aeb34b7..03ef637c 100644 --- a/test/test3.script +++ b/test/test3.script @@ -5,8 +5,8 @@ (load "../asdf") (in-package :asdf) (cl-user::quit-on-error - (let ((fasl1 (asdf:compile-file-pathname* (merge-pathnames "file1"))) - (fasl2 (asdf:compile-file-pathname* (merge-pathnames "file2")))) + (let ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (fasl2 (asdf:compile-file-pathname* (truename "file2.lisp")))) (asdf:run-shell-command "rm -f ~A ~A" (namestring fasl1) (namestring fasl2)) diff --git a/test/test4.script b/test/test4.script index 0c549fb8..668f9fb7 100644 --- a/test/test4.script +++ b/test/test4.script @@ -3,7 +3,7 @@ (load "script-support") (load "../asdf") (in-package :asdf) -(cl-user::quit-on-error +(cl-user::quit-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")) diff --git a/test/test5.not-implemented b/test/test5.not-implemented index 33c8870e..cf06f133 100644 --- a/test/test5.not-implemented +++ b/test/test5.not-implemented @@ -4,7 +4,7 @@ (load "script-support") (load "../asdf") -(exit-on-error +(exit-on-error (asdf:run-shell-command "rm ~A ~A" (namestring (compile-file-pathname "file1")) (namestring (compile-file-pathname "file2"))) diff --git a/test/test8.script b/test/test8.script index bf07b217..15207d84 100644 --- a/test/test8.script +++ b/test/test8.script @@ -6,9 +6,9 @@ (load "../asdf") (in-package #:common-lisp-user) -(quit-on-error +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (handler-case + (handler-case (asdf:oos 'asdf:load-op 'system-does-not-exist) (asdf:missing-component-of-version (c) (declare (ignore c)) diff --git a/test/test9.script b/test/test9.script index f819c49f..35cff3c5 100644 --- a/test/test9.script +++ b/test/test9.script @@ -6,15 +6,15 @@ (load "../asdf") (in-package #:common-lisp-user) -(quit-on-error +(quit-on-error (setf asdf:*central-registry* nil) (load (merge-pathnames "test9-1.asd")) (load (merge-pathnames "test9-2.asd")) - (handler-case + (handler-case (asdf:oos 'asdf:load-op 'test9-1) (asdf:missing-component-of-version (c) (format t "got missing-component-of-version as expected: - ~%~A~%" c)) - (:no-error (c) + (:no-error (c) (declare (ignore c)) (error "should have failed, oops")))) -- GitLab