From b2a7b5807be65e42b7c17d58ff2d8e69e2e64b28 Mon Sep 17 00:00:00 2001 From: Gary King <gwking@franz.com> Date: Tue, 19 May 2009 21:34:02 -0400 Subject: [PATCH] Updated tests to work print more output and work with ACL ACL's compile-file-pathname is slightly broken; worked around it. Made run-tests.sh executable. --- test/run-tests.sh | 0 test/test-retry-loading-component-1.script | 6 +++- test/test-touch-system-1.script | 1 + test/test3.script | 42 +++++++++++----------- 4 files changed, 28 insertions(+), 21 deletions(-) mode change 100644 => 100755 test/run-tests.sh diff --git a/test/run-tests.sh b/test/run-tests.sh old mode 100644 new mode 100755 diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 0afbe12f..771d4e9e 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -5,6 +5,9 @@ (load "script-support") (load "../asdf") ;(trace asdf::find-component) +;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate) +;#+allegro +;(trace excl.osi:command-output) (exit-on-error (when (probe-file "try-reloading-dependency.asd") (asdf:run-shell-command "rm -f ~A" @@ -13,12 +16,13 @@ (setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf::*defined-systems* (asdf::make-defined-systems-table)) (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") (multiple-value-bind (name mode) (find-symbol (symbol-name 'retry) :asdf) - (assert (eq mode :external)) + (assert (eq mode :external) nil "Mode of ~s was not external" name) (let ((restart (find-restart name c))) (assert restart) (when restart (invoke-restart restart))))))) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index 5360d907..7c3aa3ab 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -20,6 +20,7 @@ (asdf:run-shell-command "touch ~a" file) (asdf:find-system :test1) (let ((date2 (system-load-time :test1))) + (print (list date1 date2)) (assert date2) (assert (> date2 date1)))))) diff --git a/test/test3.script b/test/test3.script index 4c6f8f05..2a53d49e 100644 --- a/test/test3.script +++ b/test/test3.script @@ -5,24 +5,26 @@ (load "../asdf") (in-package :asdf) (cl-user::exit-on-error - (asdf:run-shell-command "rm -f ~A ~A" - (namestring (compile-file-pathname "file1")) - (namestring (compile-file-pathname "file2"))) - (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (handler-case + (let ((fasl1 (compile-file-pathname (merge-pathnames "file1"))) + (fasl2 (compile-file-pathname (merge-pathnames "file2")))) + (asdf:run-shell-command "rm -f ~A ~A" + (namestring fasl1) + (namestring fasl2)) + (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) + (declare (ignore c)) + (error "should have failed, oops"))) + (pushnew :f1 *features*) (asdf:oos 'asdf:load-op 'test3) - (asdf:missing-dependency (c) - (format t "first test failed as expected: - ~%~A~%" c)) - (:no-error (c) - (declare (ignore 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 -f ~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")))) - ) + (assert (probe-file fasl1)) + (assert (not (probe-file fasl2))) + (run-shell-command "rm -f ~A" (namestring fasl1)) + (setf *features* (cons :f2 (cdr *features*))) + (asdf:oos 'asdf:load-op 'test3) + (assert (probe-file fasl2)) + (assert (not (probe-file fasl1))) + )) -- GitLab