diff --git a/asdf.lisp b/asdf.lisp index 36cb3bde235fbfda5c0cc85f2b209cb126700820..3c5dbbdc20ddcbcf2d04aef6a1129eb6bdb019ff 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -151,6 +151,7 @@ #:clear-output-translations #:ensure-output-translations #:apply-output-translations + #:compile-file-pathname* #:initialize-source-registry #:clear-source-registry @@ -186,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.596" (1+ (length "VERSION")))) + (subseq "VERSION:1.600" (1+ (length "VERSION")))) (defun asdf-version () *asdf-version*) @@ -2244,7 +2245,7 @@ with a different configuration, so the configuration would be re-read then." (output-translations) (initialize-output-translations))) -(defmethod apply-output-translations (path) +(defun apply-output-translations (path) (ensure-output-translations) (setf path (truenamize path)) (loop :for (source destination) :in (car *output-translations*) @@ -2256,6 +2257,9 @@ with a different configuration, so the configuration would be re-read then." "Method to rewrite output files to fasl-root" (mapcar #'apply-output-translations (call-next-method))) +(defun compile-file-pathname* (input-file &rest keys) + (apply-output-translations + (apply #'compile-file-pathname input-file keys))) ;;;; ----------------------------------------------------------------- ;;;; Windows shortcut support. Based on: diff --git a/test/run-tests.sh b/test/run-tests.sh index 9c6d584d48f3431b2e99284c6a53342dc202eeb3..2ae2dfb7bbfa2d8507feea1fc5f43e79c6609c0a 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -33,8 +33,8 @@ if [ $? -eq 0 ] ; then test_pass=0 test_fail=0 failed_list="" - for i in $scripts ; - do + for i in $scripts ; + do echo "Testing: $i" >&2 test_count=`expr "$test_count" + 1` rm -f *.$2 || true @@ -134,4 +134,3 @@ else do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save" clean_up fi - diff --git a/test/script-support.lisp b/test/script-support.lisp index af482dc3a9462d715ddce43f621e1be517cb34be..081598817c26b594f9063ac295a0f520bc93c876 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -3,9 +3,6 @@ #+allegro (setf excl:*warn-on-nested-reader-conditionals* nil) -#+common-lisp-controller -(setf common-lisp-controller:*redirect-fasl-files-to-cache* nil) - ;;; code adapted from cl-launch (any errors in transcription are mine!) ;; http://www.cliki.net/cl-launch (defun leave-lisp (message return) @@ -17,7 +14,7 @@ (ext:quit return) #+(or cmu scl) (unix:unix-exit code) - #+ecl + #+ecl (si:quit return) #+gcl (lisp:quit code) @@ -31,7 +28,7 @@ (error "Don't know how to quit Lisp; wanting to use exit code ~a" return)) (defmacro quit-on-error (&body body) - `(handler-case + `(handler-case (progn ,@body (leave-lisp "~&Script succeeded~%" 0)) (error (c) diff --git a/test/test-force.script b/test/test-force.script index 4d211c66caff5c61968ba4fd46b362f83d39197a..d182deaec04717b09ac0c80c613dd0024dbc6048 100644 --- a/test/test-force.script +++ b/test/test-force.script @@ -1,20 +1,19 @@ ;;; -*- Lisp -*- (load "script-support") (load "../asdf") -(quit-on-error +(quit-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")))) + (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1")))) -(quit-on-error +(quit-on-error ;; unforced, date should stay same (sleep 1) (asdf:operate 'asdf:load-op 'test-force) - (assert (= (file-write-date (compile-file-pathname "file1")) file1-date)) + (assert (= (file-write-date (asdf: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 + (assert (> (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))) diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script index cd100f034cef0532e5d4505aa3c545789b550224..ca6769e40bffab4a3191cbb70f459104e00ce2cc 100644 --- a/test/test-static-and-serial.script +++ b/test/test-static-and-serial.script @@ -1,18 +1,17 @@ ;;; -*- Lisp -*- (load "script-support") (load "../asdf") -(quit-on-error +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'static-and-serial) - (defvar file1-date (file-write-date (compile-file-pathname "file1")))) + (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1")))) -(quit-on-error +(quit-on-error ;; cheat (setf asdf::*defined-systems* (make-hash-table :test 'equal)) - + ;; date should stay same (sleep 1) (asdf:operate 'asdf:load-op 'static-and-serial) - (assert (= (file-write-date (compile-file-pathname "file1")) file1-date)) - ) \ No newline at end of file + (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))) diff --git a/test/test1.script b/test/test1.script index 7708ce483ed50ec622496ce3586e527058b1af56..0713778b8e55e829df6fb0e799182803ed6306b9 100644 --- a/test/test1.script +++ b/test/test1.script @@ -1,38 +1,38 @@ ;;; -*- Lisp -*- (load "script-support") (load "../asdf") -(quit-on-error + +(quit-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")))) + (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))))) -(quit-on-error - (assert (and file1-date (file-write-date (compile-file-pathname "file2"))))) +(quit-on-error + (assert (and file1-date (file-write-date (asdf:compile-file-pathname* "file2")))))) ;; and loaded (assert test-package::*file1*) -(quit-on-error +(quit-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 -f ~A" - (namestring (compile-file-pathname "file2"))) + (namestring (asdf: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"))) + (assert (= file1-date (file-write-date (asdf:compile-file-pathname* "file1")))) + (assert (file-write-date (asdf:compile-file-pathname* "file2"))) ;; 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 - (let ((before (file-write-date (compile-file-pathname "file2")))) + (let ((before (file-write-date (asdf: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 + (assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before)))) diff --git a/test/test2.script b/test/test2.script index dda94476a5a95afe16a7b49dc1bace8c60d43a3a..39e2b2ec7f70c6902563ae934a5d3ae07310ad90 100644 --- a/test/test2.script +++ b/test/test2.script @@ -1,26 +1,25 @@ ;;; -*- Lisp -*- (load "script-support") (load "../asdf") -(quit-on-error +(quit-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 + (assert (and (probe-file (asdf:compile-file-pathname* "file3")) + (probe-file (asdf: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) (declare (ignore c)) (error "should have failed, oops"))) - (handler-case + (handler-case (asdf:oos 'asdf:load-op 'test2b3) (asdf:missing-dependency (c) (format t "load failed as expected: - ~%~A~%" c)) - (:no-error (c) + (:no-error (c) (declare (ignore c)) - (error "should have failed, oops"))) - ) \ No newline at end of file + (error "should have failed, oops")))) diff --git a/test/test3.script b/test/test3.script index d2a2b44d5adbef83cb7e9d4706d53c1c63889dea..8aeb34b72ce78092bd66d0d1f17f93c28502948e 100644 --- a/test/test3.script +++ b/test/test3.script @@ -4,18 +4,18 @@ (load "script-support") (load "../asdf") (in-package :asdf) -(cl-user::quit-on-error - (let ((fasl1 (compile-file-pathname (merge-pathnames "file1"))) - (fasl2 (compile-file-pathname (merge-pathnames "file2")))) +(cl-user::quit-on-error + (let ((fasl1 (asdf:compile-file-pathname* (merge-pathnames "file1"))) + (fasl2 (asdf: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 + (handler-case (asdf:oos 'asdf:load-op 'test3) (asdf:missing-dependency (c) (format t "first test failed as expected: - ~%~A~%" c)) - (:no-error (c) + (:no-error (c) (declare (ignore c)) (error "should have failed, oops"))) (pushnew :f1 *features*) @@ -26,5 +26,4 @@ (setf *features* (cons :f2 (cdr *features*))) (asdf:oos 'asdf:load-op 'test3) (assert (probe-file fasl2)) - (assert (not (probe-file fasl1))) - )) + (assert (not (probe-file fasl1)))))