Commit b2a7b580 authored by Gary King's avatar Gary King

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.
parent f7973971
File mode changed from 100644 to 100755
...@@ -5,6 +5,9 @@ ...@@ -5,6 +5,9 @@
(load "script-support") (load "script-support")
(load "../asdf") (load "../asdf")
;(trace asdf::find-component) ;(trace asdf::find-component)
;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
;#+allegro
;(trace excl.osi:command-output)
(exit-on-error (exit-on-error
(when (probe-file "try-reloading-dependency.asd") (when (probe-file "try-reloading-dependency.asd")
(asdf:run-shell-command "rm -f ~A" (asdf:run-shell-command "rm -f ~A"
...@@ -13,12 +16,13 @@ ...@@ -13,12 +16,13 @@
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
(setf asdf::*defined-systems* (asdf::make-defined-systems-table)) (setf asdf::*defined-systems* (asdf::make-defined-systems-table))
(handler-bind ((error (lambda (c) (handler-bind ((error (lambda (c)
(format t "~&Caught error ~s" c)
(setf *caught-error* t) (setf *caught-error* t)
(asdf:run-shell-command (asdf:run-shell-command
"cp try-reloading-dependency.hidden try-reloading-dependency.asd") "cp try-reloading-dependency.hidden try-reloading-dependency.asd")
(multiple-value-bind (name mode) (multiple-value-bind (name mode)
(find-symbol (symbol-name 'retry) :asdf) (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))) (let ((restart (find-restart name c)))
(assert restart) (assert restart)
(when restart (invoke-restart restart))))))) (when restart (invoke-restart restart)))))))
......
...@@ -20,6 +20,7 @@ ...@@ -20,6 +20,7 @@
(asdf:run-shell-command "touch ~a" file) (asdf:run-shell-command "touch ~a" file)
(asdf:find-system :test1) (asdf:find-system :test1)
(let ((date2 (system-load-time :test1))) (let ((date2 (system-load-time :test1)))
(print (list date1 date2))
(assert date2) (assert date2)
(assert (> date2 date1)))))) (assert (> date2 date1))))))
...@@ -5,24 +5,26 @@ ...@@ -5,24 +5,26 @@
(load "../asdf") (load "../asdf")
(in-package :asdf) (in-package :asdf)
(cl-user::exit-on-error (cl-user::exit-on-error
(asdf:run-shell-command "rm -f ~A ~A" (let ((fasl1 (compile-file-pathname (merge-pathnames "file1")))
(namestring (compile-file-pathname "file1")) (fasl2 (compile-file-pathname (merge-pathnames "file2"))))
(namestring (compile-file-pathname "file2"))) (asdf:run-shell-command "rm -f ~A ~A"
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (namestring fasl1)
(handler-case (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:oos 'asdf:load-op 'test3)
(asdf:missing-dependency (c) (assert (probe-file fasl1))
(format t "first test failed as expected: - ~%~A~%" c)) (assert (not (probe-file fasl2)))
(:no-error (c) (run-shell-command "rm -f ~A" (namestring fasl1))
(declare (ignore c)) (setf *features* (cons :f2 (cdr *features*)))
(error "should have failed, oops"))) (asdf:oos 'asdf:load-op 'test3)
(pushnew :f1 *features*) (assert (probe-file fasl2))
(asdf:oos 'asdf:load-op 'test3) (assert (not (probe-file fasl1)))
(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"))))
)
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