Skip to content
Snippets Groups Projects
Commit ea78e21b authored by Gary King's avatar Gary King
Browse files

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

parent fd39ddb1
No related branches found
No related tags found
No related merge requests found
...@@ -4,19 +4,38 @@ sok=1 ...@@ -4,19 +4,38 @@ sok=1
do_tests() { do_tests() {
rm *.$2 || true rm *.$2 || true
( cd .. && echo '(compile-file "asdf")' |$1 ) ( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 )
for i in *.script; if [ $? -eq 0 ] ; then
do test_count=0
rm *.$2 || true test_pass=0
if $1 < $i ;then test_fail=0
echo "Using $1, $i passed" >&2 failed_list=""
else for i in *.script;
echo "Using $1, $i failed" >&2 do
sok=0 echo "Testing: $i" >&2
exit 1 test_count=`expr "$test_count" + 1`
fi rm *.$2 || true
done if $1 < $i ;then
echo "Using $1, all tests apparently successful ($sok)" >&2 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} # do_tests {lisp invocation} {fasl extension}
...@@ -24,19 +43,43 @@ echo "Using $1, all tests apparently successful ($sok)" >&2 ...@@ -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 on getting eof
# - quit with exit status >0 if an unhandled error occurs # - quit with exit status >0 if an unhandled error occurs
# terminate on error
set -e set -e
if type sbcl lisp=$1
then if [ -z $1 ] ; then
do_tests "sbcl --userinit /dev/null --sysinit /dev/null --noprogrammer" fasl lisp="sbcl"
fi fi
if [ -x /usr/bin/lisp ] if [ "$lisp" = "sbcl" ] ; then
then if type sbcl ; then
do_tests "/usr/bin/lisp -batch -noinit" x86f 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 fi
if [ -x /usr/bin/clisp ]
then #if [ -x /usr/bin/lisp ]
do_tests "/usr/bin/clisp -norc -ansi -I - " fas #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 fi
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (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) (asdf:operate 'asdf:load-op 'test-force)
(defvar file1-date (file-write-date (compile-file-pathname "file1"))) (defvar file1-date (file-write-date (compile-file-pathname "file1")))
;; unforced, date should stay same ;; unforced, date should stay same
(sleep 1) (sleep 1)
(asdf:operate 'asdf:load-op 'test-force) (asdf:operate 'asdf:load-op 'test-force)
(assert (= (file-write-date (compile-file-pathname "file1")) file1-date)) (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
;; forced, it should be later ;; forced, it should be later
(sleep 1) (sleep 1)
(asdf:operate 'asdf:load-op 'test-force :force t) (asdf:operate 'asdf:load-op 'test-force :force t)
(assert (> (file-write-date (compile-file-pathname "file1")) file1-date)) (assert (> (file-write-date (compile-file-pathname "file1")) file1-date))
)
\ No newline at end of file
(in-package :cl-user) (in-package :cl-user)
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (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 -*- ;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (exit-on-error
(in-package :asdf) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:oos 'asdf:load-op 'test-preferences-system-1) (in-package :asdf)
(assert (eq common-lisp-user::*test-preferences-variable-1* :load)) (asdf:oos 'asdf:load-op 'test-preferences-system-1)
(asdf:oos 'asdf:test-op 'test-preferences-system-1) (assert (eq common-lisp-user::*test-preferences-variable-1* :load))
(assert (eq common-lisp-user::*test-preferences-variable-1* :test)) (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") (load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
...@@ -8,23 +8,24 @@ ...@@ -8,23 +8,24 @@
(in-package :test-version-system) (in-package :test-version-system)
(defsystem :versioned-system-1 (cl-user::exit-on-error
:pathname #.*default-pathname-defaults* (defsystem :versioned-system-1
:version "1.0") :pathname #.*default-pathname-defaults*
:version "1.0")
(defsystem :versioned-system-2 (defsystem :versioned-system-2
:pathname #.*default-pathname-defaults* :pathname #.*default-pathname-defaults*
:version "1.1") :version "1.1")
(defsystem :versioned-system-3 (defsystem :versioned-system-3
:pathname #.*default-pathname-defaults* :pathname #.*default-pathname-defaults*
:version "1.2") :version "1.2")
(flet ((test (name v &optional (true t)) (flet ((test (name v &optional (true t))
(or (eq true (asdf::version-satisfies (find-system name) v)) (or (eq true (asdf::version-satisfies (find-system name) v))
(error "no satisfaction: ~S version ~A not ~A" name v true)))) (error "no satisfaction: ~S version ~A not ~A" name v true))))
(test :versioned-system-1 "1.0") (test :versioned-system-1 "1.0")
(test :versioned-system-2 "1.0") (test :versioned-system-2 "1.0")
(test :versioned-system-3 "2.0" nil)) (test :versioned-system-3 "2.0" nil))
)
\ No newline at end of file \ No newline at end of file
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (exit-on-error
(asdf:operate 'asdf:load-op 'test1) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test1)
;; test that it compiled ;; test that it compiled
(defvar file1-date (file-write-date (compile-file-pathname "file1"))) (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 ;; and loaded
(assert test-package::*file1*) (assert test-package::*file1*)
;; now remove one output file and check that the other is _not_ (exit-on-error
;; recompiled ;; now remove one output file and check that the other is _not_
(sleep 1) ; mtime has 1-second granularity, so pause here for fast machines ;; recompiled
(sleep 1) ; mtime has 1-second granularity, so pause here for fast machines
(asdf::run-shell-command "rm ~A" (asdf::run-shell-command "rm ~A"
(namestring (compile-file-pathname "file2"))) (namestring (compile-file-pathname "file2")))
(asdf:operate 'asdf:load-op 'test1) (asdf:operate 'asdf:load-op 'test1)
(assert (= file1-date (file-write-date (compile-file-pathname "file1")))) (assert (= file1-date (file-write-date (compile-file-pathname "file1"))))
(assert (file-write-date (compile-file-pathname "file2"))) (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 ;; 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 ;; 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")))) (let ((before (file-write-date (compile-file-pathname "file2"))))
(asdf::run-shell-command "touch file1.lisp") (asdf::run-shell-command "touch file1.lisp")
(sleep 1) (sleep 1)
(asdf:operate 'asdf:load-op 'test1) (asdf:operate 'asdf:load-op 'test1)
(assert (> (file-write-date (compile-file-pathname "file2")) before))) (assert (> (file-write-date (compile-file-pathname "file2")) before)))
)
\ No newline at end of file
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (exit-on-error
;(trace asdf::perform) (setf asdf:*central-registry* '(*default-pathname-defaults*))
;(trace asdf::find-component) ;(trace asdf::perform)
;(trace asdf::traverse) ;(trace asdf::find-component)
(asdf:oos 'asdf:load-op 'test2b1) ;(trace asdf::traverse)
(assert (and (probe-file (compile-file-pathname "file3")) (asdf:oos 'asdf:load-op 'test2b1)
(probe-file (compile-file-pathname "file4")))) (assert (and (probe-file (compile-file-pathname "file3"))
(handler-case (probe-file (compile-file-pathname "file4"))))
(asdf:oos 'asdf:load-op 'test2b2) (handler-case
(asdf:missing-dependency (c) (asdf:oos 'asdf:load-op 'test2b2)
(format t "load failed as expected: - ~%~A~%" c)) (asdf:missing-dependency (c)
(:no-error (c) (error "should have failed, oops"))) (format t "load failed as expected: - ~%~A~%" c))
(handler-case (:no-error (c) (error "should have failed, oops")))
(asdf:oos 'asdf:load-op 'test2b3) (handler-case
(asdf:missing-dependency (c) (asdf:oos 'asdf:load-op 'test2b3)
(format t "load failed as expected: - ~%~A~%" c)) (asdf:missing-dependency (c)
(:no-error (c) (error "should have failed, oops"))) (format t "load failed as expected: - ~%~A~%" c))
(:no-error (c) (error "should have failed, oops")))
)
\ No newline at end of file
;;; -*- Lisp -*- ;;; -*- Lisp -*-
#+(or f1 f2) #+(or f1 f2)
(error "This test cannot run if :f1 or :f2 are on *features*") (error "This test cannot run if :f1 or :f2 are on *features*")
(load "script-support")
(load "../asdf") (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) (in-package :asdf)
(handler-case (cl-user::exit-on-error
(asdf:oos 'asdf:load-op 'test3) (asdf:run-shell-command "rm ~A ~A"
(asdf:missing-dependency (c) (namestring (compile-file-pathname "file1"))
(format t "first test failed as expected: - ~%~A~%" c)) (namestring (compile-file-pathname "file2")))
(:no-error (c) (error "should have failed, oops"))) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(pushnew :f1 *features*) (handler-case
(asdf:oos 'asdf:load-op 'test3) (asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file1"))) (asdf:missing-dependency (c)
(assert (not (probe-file (compile-file-pathname "file2")))) (format t "first test failed as expected: - ~%~A~%" c))
(run-shell-command "rm ~A" (namestring (compile-file-pathname "file1"))) (:no-error (c) (error "should have failed, oops")))
(setf *features* (cons :f2 (cdr *features*))) (pushnew :f1 *features*)
(asdf:oos 'asdf:load-op 'test3) (asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file2"))) (assert (probe-file (compile-file-pathname "file1")))
(assert (not (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 -*-
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (load "../asdf")
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(in-package :asdf) (in-package :asdf)
(assert (not (component-property (find-system 'test3) :foo))) (cl-user::exit-on-error
(assert (equal (component-property (find-system 'test3) :prop1) "value")) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(setf (component-property (find-system 'test3) :foo) "bar") (assert (not (component-property (find-system 'test3) :foo)))
(assert (equal (component-property (find-system 'test3) :foo) "bar")) (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 -*- ;;; -*- Lisp -*-
(load "script-support")
(load "../asdf") (load "../asdf")
(load "../wild-modules") (exit-on-error
(load "../asdf")
(load "../wild-modules")
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'wild-module) (asdf:operate 'asdf:load-op 'wild-module)
)
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment