[asdf-devel] [PATCH 2/2] More carefully look for compiled asdf.lisp.

From: Robert P. Goldman rpgoldman@real-time.com

Found that the current load recipe (load "../asdf") in the test scripts was brittle, because the presence of asdf.fasl was obscured if there was an "asdf/" directory in .. Unfortunately, the result of makeinfo --html asdf.texinfo created just such a directory! fe[nl]ix kindly provided a pointer to compile-file-pathname that solved the problem. --- test/test-force.script | 6 +++--- test/test-module-pathnames.script | 14 +++++++------- test/test-nested-components.script | 10 +++++----- test/test-package.script | 2 +- test/test-retry-loading-component-1.script | 6 +++--- test/test-static-and-serial.script | 8 ++++---- test/test-touch-system-1.script | 4 ++-- test/test-touch-system-2.script | 4 ++-- test/test-try-recompiling-1.script | 8 ++++---- test/test-utilities.script | 2 +- test/test-version.script | 4 ++-- test/test1.script | 8 ++++---- test/test2.script | 10 +++++----- test/test3.script | 8 ++++---- test/test4.script | 4 ++-- test/test8.script | 6 +++--- test/test9.script | 8 ++++---- test/wild-module.script | 6 +++--- 18 files changed, 59 insertions(+), 59 deletions(-)

diff --git a/test/test-force.script b/test/test-force.script index 4d211c6..ed76668 100644 --- a/test/test-force.script +++ b/test/test-force.script @@ -1,13 +1,13 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(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"))))

-(quit-on-error +(quit-on-error ;; unforced, date should stay same (sleep 1) (asdf:operate 'asdf:load-op 'test-force) diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script index 310c94a..d7a1995 100644 --- a/test/test-module-pathnames.script +++ b/test/test-module-pathnames.script @@ -1,8 +1,8 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf"))

-(quit-on-error +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:load-system 'test-module-pathnames) (flet ((submodule (module name) @@ -23,7 +23,7 @@ (pathname-foo (asdf:component-relative-pathname static)) '((:relative "level2") "static" "file")) nil - "Didn't get the name of static.file right"))) + "Didn't get the name of static.file right"))) (assert (find-package :test-package) nil "package test-package not found") (assert (find-symbol (symbol-name '*file-tmp*) :test-package) nil @@ -32,8 +32,8 @@ nil "symbol `*file-tmp*` has wrong value")

#| ; must be adapted to ABL - (assert (probe-file (merge-pathnames - (make-pathname + (assert (probe-file (merge-pathnames + (make-pathname :name "file1" :type (pathname-type (compile-file-pathname "x")) :directory '(:relative "sources" "level1")))) @@ -47,8 +47,8 @@

#| ; must be adapted to ABL

- (assert (probe-file (merge-pathnames - (make-pathname + (assert (probe-file (merge-pathnames + (make-pathname :name "file2" :type (pathname-type (compile-file-pathname "x")) :directory '(:relative "sources" "level1" "level2")))) diff --git a/test/test-nested-components.script b/test/test-nested-components.script index 7e16b5a..3707c45 100644 --- a/test/test-nested-components.script +++ b/test/test-nested-components.script @@ -3,13 +3,13 @@ ;;; check that added nesting via modules doesn't confuse ASDF

(load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package #:common-lisp-user)

-(quit-on-error +(quit-on-error (setf asdf:*central-registry* nil) (load (merge-pathnames "test-nested-components-1.asd")) - (print + (print (list :a (asdf::traverse (make-instance 'asdf:compile-op) @@ -28,7 +28,7 @@ (asdf:oos 'asdf:compile-op 'test-nested-components-a) (asdf:oos 'asdf:compile-op 'test-nested-components-b)

- (print + (print (list (asdf::traverse (make-instance 'asdf:load-op) (asdf:find-system 'test-nested-components-a)) @@ -56,7 +56,7 @@ . #<ASDF:MODULE "preflight-checks" {11B799A9}>) (#<ASDF:LOAD-OP NIL {11D04FE9}> . #<ASDF:SYSTEM "test-nested-components-a" {11AEDD59}>)) - + ((#<ASDF:COMPILE-OP NIL {11E4D9B1}> . #<ASDF:CL-SOURCE-FILE "preflight" {11C94B89}>) (#<ASDF:COMPILE-OP NIL {11E4D9B1}> diff --git a/test/test-package.script b/test/test-package.script index 7fe534d..69fac7c 100644 --- a/test/test-package.script +++ b/test/test-package.script @@ -1,7 +1,7 @@ (in-package :cl-user) ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (quit-on-error

(defun module () 1) diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 0975bb1..96481d6 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -3,19 +3,19 @@ ;;; test asdf:try-recompiling restart

(load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) ;(trace asdf::find-component) ;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate) ;#+allegro ;(trace excl.osi:command-output) (defvar *caught-error* nil) -(quit-on-error +(quit-on-error (when (probe-file "try-reloading-dependency.asd") (asdf:run-shell-command "rm -f ~A" (namestring "try-reloading-dependency.asd"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) (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) (asdf:run-shell-command diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script index cd100f0..7c7155c 100644 --- a/test/test-static-and-serial.script +++ b/test/test-static-and-serial.script @@ -1,16 +1,16 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(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"))))

-(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) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index 0ddeefd..250ce9b 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -4,8 +4,8 @@ ;;; system that can be found using *system-definition-search-functions*

(load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) (when data diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script index 82717fb..cf43f23 100644 --- a/test/test-touch-system-2.script +++ b/test/test-touch-system-2.script @@ -4,8 +4,8 @@ ;;; system that canNOT be found using *system-definition-search-functions*

(load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) (when data diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script index 9dbc9a9..85dbf8d 100644 --- a/test/test-try-recompiling-1.script +++ b/test/test-try-recompiling-1.script @@ -3,15 +3,15 @@ ;;; test asdf:try-recompiling restart

(load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (defvar *caught-error* nil)

-(quit-on-error +(quit-on-error (asdf:run-shell-command "rm -f ~A" - (namestring + (namestring (compile-file-pathname "try-recompiling-1"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (handler-bind ((error (lambda (c) + (handler-bind ((error (lambda (c) (setf *caught-error* t) (multiple-value-bind (name mode) (find-symbol diff --git a/test/test-utilities.script b/test/test-utilities.script index 66569fa..5dadd63 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package :asdf) (cl-user::quit-on-error

diff --git a/test/test-version.script b/test/test-version.script index 783cec8..621e009 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (setf asdf:*central-registry* '(*default-pathname-defaults*))

(defpackage :test-version-system @@ -8,7 +8,7 @@

(in-package :test-version-system)

-(cl-user::quit-on-error +(cl-user::quit-on-error (defsystem :versioned-system-1 :pathname #.*default-pathname-defaults* :version "1.0") diff --git a/test/test1.script b/test/test1.script index 7708ce4..f18030e 100644 --- a/test/test1.script +++ b/test/test1.script @@ -1,20 +1,20 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(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"))))

-(quit-on-error +(quit-on-error (assert (and file1-date (file-write-date (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 diff --git a/test/test2.script b/test/test2.script index dda9447..f7321c6 100644 --- a/test/test2.script +++ b/test/test2.script @@ -1,7 +1,7 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) ;(trace asdf::perform) ;(trace asdf::find-component) @@ -9,18 +9,18 @@ (asdf:oos 'asdf:load-op 'test2b1) (assert (and (probe-file (compile-file-pathname "file3")) (probe-file (compile-file-pathname "file4")))) - (handler-case + (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 diff --git a/test/test3.script b/test/test3.script index d2a2b44..005e627 100644 --- a/test/test3.script +++ b/test/test3.script @@ -2,20 +2,20 @@ #+(or f1 f2) (error "This test cannot run if :f1 or :f2 are on *features*") (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package :asdf) -(cl-user::quit-on-error +(cl-user::quit-on-error (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 + (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*) diff --git a/test/test4.script b/test/test4.script index 0c549fb..d921341 100644 --- a/test/test4.script +++ b/test/test4.script @@ -1,9 +1,9 @@ ;;; -*- Lisp -*- ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package :asdf) -(cl-user::quit-on-error +(cl-user::quit-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")) diff --git a/test/test8.script b/test/test8.script index bf07b21..d6338b9 100644 --- a/test/test8.script +++ b/test/test8.script @@ -3,12 +3,12 @@ ;;; make sure we get a missing-component error

(load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package #:common-lisp-user)

-(quit-on-error +(quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (handler-case + (handler-case (asdf:oos 'asdf:load-op 'system-does-not-exist) (asdf:missing-component-of-version (c) (declare (ignore c)) diff --git a/test/test9.script b/test/test9.script index f819c49..eeaf1a8 100644 --- a/test/test9.script +++ b/test/test9.script @@ -3,18 +3,18 @@ ;;; make sure we get a missing-component-of-version error

(load "script-support") -(load "../asdf") +(load (compile-file-pathname "../asdf")) (in-package #:common-lisp-user)

-(quit-on-error +(quit-on-error (setf asdf:*central-registry* nil) (load (merge-pathnames "test9-1.asd")) (load (merge-pathnames "test9-2.asd")) - (handler-case + (handler-case (asdf:oos 'asdf:load-op 'test9-1) (asdf:missing-component-of-version (c) (format t "got missing-component-of-version as expected: - ~%~A~%" c)) - (:no-error (c) + (:no-error (c) (declare (ignore c)) (error "should have failed, oops"))))

diff --git a/test/wild-module.script b/test/wild-module.script index c45a95b..3ccfc1f 100644 --- a/test/wild-module.script +++ b/test/wild-module.script @@ -1,9 +1,9 @@ ;;; -*- Lisp -*- (load "script-support") -(load "../asdf") -(quit-on-error +(load (compile-file-pathname "../asdf")) +(quit-on-error

- (load "../asdf") + (load (compile-file-pathname "../asdf")) (load "../wild-modules")

(setf asdf:*central-registry* '(*default-pathname-defaults*))