Commit ea78e21b authored by Gary King's avatar Gary King

Reworked asdf tests to make them more robust and perhaps more flexible too.

parent fd39ddb1
......@@ -4,19 +4,38 @@ sok=1
do_tests() {
rm *.$2 || true
( cd .. && echo '(compile-file "asdf")' |$1 )
for i in *.script;
do
rm *.$2 || true
if $1 < $i ;then
echo "Using $1, $i passed" >&2
else
echo "Using $1, $i failed" >&2
sok=0
exit 1
fi
done
echo "Using $1, all tests apparently successful ($sok)" >&2
( 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
fi
done
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 @@ echo "Using $1, all tests apparently successful ($sok)" >&2
# - 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
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(exit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test-force)
(defvar file1-date (file-write-date (compile-file-pathname "file1")))
(asdf:operate 'asdf:load-op 'test-force)
(defvar file1-date (file-write-date (compile-file-pathname "file1")))
;; unforced, date should stay same
(sleep 1)
(asdf:operate 'asdf:load-op 'test-force)
(assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
;; unforced, date should stay same
(sleep 1)
(asdf:operate 'asdf:load-op 'test-force)
(assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
;; forced, it should be later
(sleep 1)
(asdf:operate 'asdf:load-op 'test-force :force t)
(assert (> (file-write-date (compile-file-pathname "file1")) file1-date))
;; forced, it should be later
(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
(in-package :cl-user)
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(exit-on-error
(defun module () 1)
(defun module () 1)
(load "test-package.asd")
(load "test-package.asd")
(defclass module () ())
(defclass module () ())
(load "test-package.asd")
(load "test-package.asd")
)
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(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))
(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
;; -*- lisp -*-
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
......@@ -8,23 +8,24 @@
(in-package :test-version-system)
(defsystem :versioned-system-1
:pathname #.*default-pathname-defaults*
:version "1.0")
(cl-user::exit-on-error
(defsystem :versioned-system-1
:pathname #.*default-pathname-defaults*
:version "1.0")
(defsystem :versioned-system-2
:pathname #.*default-pathname-defaults*
:version "1.1")
(defsystem :versioned-system-2
:pathname #.*default-pathname-defaults*
:version "1.1")
(defsystem :versioned-system-3
:pathname #.*default-pathname-defaults*
:version "1.2")
(defsystem :versioned-system-3
:pathname #.*default-pathname-defaults*
:version "1.2")
(flet ((test (name v &optional (true t))
(or (eq true (asdf::version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true))))
(test :versioned-system-1 "1.0")
(test :versioned-system-2 "1.0")
(test :versioned-system-3 "2.0" nil))
(flet ((test (name v &optional (true t))
(or (eq true (asdf::version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true))))
(test :versioned-system-1 "1.0")
(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
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test1)
(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"))))
;; 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")))))
;; and loaded
(assert test-package::*file1*)
;; 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
(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
(asdf::run-shell-command "rm ~A"
(namestring (compile-file-pathname "file2")))
(asdf:operate 'asdf:load-op 'test1)
(assert (= file1-date (file-write-date (compile-file-pathname "file1"))))
(assert (file-write-date (compile-file-pathname "file2")))
(asdf::run-shell-command "rm ~A"
(namestring (compile-file-pathname "file2")))
(asdf:operate 'asdf:load-op 'test1)
(assert (= file1-date (file-write-date (compile-file-pathname "file1"))))
(assert (file-write-date (compile-file-pathname "file2")))
;; now touch file1 and check that file2 _is_ also recompiled
;; now touch file1 and check that file2 _is_ also recompiled
;; XXX run-shell-command loses if *default-pathname-defaults* is not the
;; unix cwd. this is not a problem for run-tests.sh, but can be in general
;; XXX run-shell-command loses if *default-pathname-defaults* is not the
;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(let ((before (file-write-date (compile-file-pathname "file2"))))
(asdf::run-shell-command "touch file1.lisp")
(sleep 1)
(asdf:operate 'asdf:load-op 'test1)
(assert (> (file-write-date (compile-file-pathname "file2")) before)))
(let ((before (file-write-date (compile-file-pathname "file2"))))
(asdf::run-shell-command "touch file1.lisp")
(sleep 1)
(asdf:operate 'asdf:load-op 'test1)
(assert (> (file-write-date (compile-file-pathname "file2")) before)))
)
\ No newline at end of file
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(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 (compile-file-pathname "file3"))
(probe-file (compile-file-pathname "file4"))))
(handler-case
(asdf:oos 'asdf:load-op 'test2b2)
(asdf:missing-dependency (c)
(format t "load failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
(handler-case
(asdf:oos 'asdf:load-op 'test2b3)
(asdf:missing-dependency (c)
(format t "load failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
(exit-on-error
(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 (compile-file-pathname "file3"))
(probe-file (compile-file-pathname "file4"))))
(handler-case
(asdf:oos 'asdf:load-op 'test2b2)
(asdf:missing-dependency (c)
(format t "load failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
(handler-case
(asdf:oos 'asdf:load-op 'test2b3)
(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
;;; -*- Lisp -*-
#+(or f1 f2)
(error "This test cannot run if :f1 or :f2 are on *features*")
(load "script-support")
(load "../asdf")
(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)
(format t "first test failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
(pushnew :f1 *features*)
(asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file1")))
(assert (not (probe-file (compile-file-pathname "file2"))))
(run-shell-command "rm ~A" (namestring (compile-file-pathname "file1")))
(setf *features* (cons :f2 (cdr *features*)))
(asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file2")))
(assert (not (probe-file (compile-file-pathname "file1"))))
(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*))
(handler-case
(asdf:oos 'asdf:load-op 'test3)
(asdf:missing-dependency (c)
(format t "first test failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
(pushnew :f1 *features*)
(asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file1")))
(assert (not (probe-file (compile-file-pathname "file2"))))
(run-shell-command "rm ~A" (namestring (compile-file-pathname "file1")))
(setf *features* (cons :f2 (cdr *features*)))
(asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file2")))
(assert (not (probe-file (compile-file-pathname "file1"))))
)
;;; -*- Lisp -*-
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(in-package :asdf)
(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"))
(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
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(load "../wild-modules")
(exit-on-error
(load "../asdf")
(load "../wild-modules")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'wild-module)
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'wild-module)
)
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment