Skip to content
Snippets Groups Projects
Commit 8c2b2625 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files
Conflicts:
	test/compile-asdf.lisp
	test/test-retry-loading-component-1.script
	test/test-touch-system-1.script
	test/test-touch-system-2.script
	test/test2.script
parents 0ca845e6 71437300
No related branches found
No related tags found
No related merge requests found
Showing
with 118 additions and 86 deletions
......@@ -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
......
......@@ -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.600" (1+ (length "VERSION"))))
(subseq "VERSION:1.602" (1+ (length "VERSION"))))
(defun asdf-version ()
*asdf-version*)
......@@ -438,7 +438,7 @@ and NIL NAME and TYPE components" ;;; what about VERSION???
#+cmu
(cdr (assoc (intern x :keyword) ext:*environment-list*))
#+lispworks
(lispworks:environment-xiable x)
(lispworks:environment-variable x)
#+allegro
(sys:getenv x)
#+gcl
......@@ -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)))
......@@ -935,6 +935,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)))
......@@ -991,7 +992,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
)
......@@ -2191,8 +2192,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)
......@@ -2508,8 +2509,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)
......
......@@ -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)))
......@@ -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
......
;;; -*- 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)
......
;;; -*- 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"
......
......@@ -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*)))
......@@ -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)))
......@@ -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)))))
......
......@@ -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
......@@ -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)))))
#|
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...
|#
......
......@@ -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
|#
......@@ -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
|#
(in-package :cl-user)
;;; -*- Lisp -*-
(in-package :cl-user)
(load "script-support")
(load (compile-file-pathname "../asdf"))
(quit-on-error
(defun module () 1)
(load "test-package.asd")
(defclass module () ())
(load "test-package.asd")
)
(load "test-package.asd"))
......@@ -10,24 +10,29 @@
;(trace excl.osi:command-output)
(defvar *caught-error* nil)
(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))
(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*))
......@@ -12,7 +12,7 @@
(merge-pathnames path defaults))
(defun ensure-recursive-directory (path)
(concatenate
(concatenate
'string
(namestring
(ensure-directory-pathname path))
......
;;; -*- Lisp -*-
(asdf:defsystem test1
(asdf:defsystem test1
:components ((:file "file2" :in-order-to ((compile-op (load-op "file1"))))
(:file "file1")))
......
......@@ -2,14 +2,16 @@
(load "script-support")
(load (compile-file-pathname "../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)
......@@ -17,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)
......
......@@ -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")))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment