diff --git a/asdf.lisp b/asdf.lisp index 4c3b982f24790e943e36f2e75a361e43f5abe50f..c4f6e87f4c83d822136b9905b9df3be9ffd27498 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,4 +1,4 @@ -;;; This is asdf: Another System Definition Facility. $Revision: 1.122 $ +;;; This is asdf: Another System Definition Facility. $Revision: 1.123 $ ;;; ;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; <cclan-list@lists.sf.net>. But note first that the canonical @@ -119,7 +119,7 @@ (in-package #:asdf) -(defvar *asdf-revision* (let* ((v "$Revision: 1.122 $") +(defvar *asdf-revision* (let* ((v "$Revision: 1.123 $") (colon (or (position #\: v) -1)) (dot (position #\. v))) (and v colon dot @@ -371,8 +371,13 @@ and NIL NAME and TYPE components" '(sysdef-central-registry-search)) (defun system-definition-pathname (system) - (some (lambda (x) (funcall x system)) - *system-definition-search-functions*)) + (let ((system-name (coerce-name system))) + (or + (some (lambda (x) (funcall x system-name)) + *system-definition-search-functions*) + (let ((system-pair (gethash system-name *defined-systems*))) + (and system-pair + (system-source-file (cdr system-pair))))))) (defvar *central-registry* '(*default-pathname-defaults* @@ -701,8 +706,7 @@ the head of the tree")) (or (member (car dep) *features*) (error 'missing-dependency :required-by c - :requires (car dep) - :version nil))) + :requires (car dep)))) (t (dolist (d dep) (cond ((consp d) @@ -1310,13 +1314,21 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." (error "RUN-SHELL-PROGRAM not implemented for this Lisp") )) -(defun system-source-file (system-name) - (let ((system (asdf:find-system system-name))) - (make-pathname - :type "asd" - :name (asdf:component-name system) - :defaults (asdf:component-relative-pathname system)))) - +(defgeneric system-source-file (system) + (:documentation "Return the source file in which system is defined.")) + +(defmethod system-source-file ((system-name t)) + (system-source-file (find-system system-name))) + +(defmethod system-source-file ((system system)) + (let ((pn (and (slot-boundp system 'relative-pathname) + (make-pathname + :type "asd" + :name (asdf:component-name system) + :defaults (asdf:component-relative-pathname system))))) + (when pn + (probe-file pn)))) + (defun system-source-directory (system-name) (make-pathname :name nil :type nil diff --git a/test/run-tests.sh b/test/run-tests.sh index 59fa14cc3d240388900f1a5dbd3413e8dedef0b3..0b4afe088f7430ef6c7fc64b7256e88c4d68c478 100644 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -19,13 +19,13 @@ fi if [ -z "$2" ]; then scripts="*.script" else - scripts="$2.script" + scripts="$2" fi sok=1 do_tests() { -rm *.$2 || true +rm -f *.$2 || true ( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 ) if [ $? -eq 0 ] ; then test_count=0 @@ -36,7 +36,7 @@ if [ $? -eq 0 ] ; then do echo "Testing: $i" >&2 test_count=`expr "$test_count" + 1` - rm *.$2 || true + rm -f *.$2 || true if $1 < $i ; then echo "Using $1, $i passed" >&2 test_pass=`expr "$test_pass" + 1` @@ -76,7 +76,7 @@ if [ "$lisp" = "sbcl" ] ; then elif [ "$lisp" = "clisp" ] ; then if type clisp ; then fasl_ext="fas" - command=`where clisp` + command=`which clisp` command="$command -norc -ansi -I - " fi elif [ "$lisp" = "allegro" ] ; then diff --git a/test/script-support.lisp b/test/script-support.lisp index 9317804c81df5a75864d9a6f7e6db99d78765807..64f482b91f8f03366b952a76ed29c479ecc8b5cc 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -33,4 +33,4 @@ (leave-lisp "Script succeeded" 0)) (error (c) (format *error-output* "~a" c) - (leave-lisp "Script failed" 1)))) \ No newline at end of file + (leave-lisp "Script failed" 1)))) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script new file mode 100644 index 0000000000000000000000000000000000000000..5360d9072feb15d824100ab6cc6f5e306b3e2504 --- /dev/null +++ b/test/test-touch-system-1.script @@ -0,0 +1,25 @@ +;;; -*- Lisp -*- + +;;; test system def reloading if touched +;;; system that can be found using *system-definition-search-functions* + +(load "script-support") +(load "../asdf") +(exit-on-error + (flet ((system-load-time (name) + (let ((data (asdf::system-registered-p name))) + (when data + (car data))))) + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (asdf:find-system :test1) + (let ((date1 (system-load-time :test1)) + (file (namestring (merge-pathnames "test1.asd")))) + (assert date1) + (assert file) + (sleep 1) + (asdf:run-shell-command "touch ~a" file) + (asdf:find-system :test1) + (let ((date2 (system-load-time :test1))) + (assert date2) + (assert (> date2 date1)))))) + diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script new file mode 100644 index 0000000000000000000000000000000000000000..82511d2e0877e3f798424ce251340458cae509ad --- /dev/null +++ b/test/test-touch-system-2.script @@ -0,0 +1,26 @@ +;;; -*- Lisp -*- + +;;; test system def reloading if touched +;;; system that canNOT be found using *system-definition-search-functions* + +(load "script-support") +(load "../asdf") +(exit-on-error + (flet ((system-load-time (name) + (let ((data (asdf::system-registered-p name))) + (when data + (car data))))) + (setf asdf:*central-registry* nil) + (load (merge-pathnames "test1.asd")) + (assert (asdf:find-system :test1)) + (let ((date1 (system-load-time :test1)) + (file (namestring (merge-pathnames "test1.asd")))) + (assert date1) + (assert file) + (sleep 1) + (asdf:run-shell-command "touch ~a" file) + (asdf:find-system :test1) + (let ((date2 (system-load-time :test1))) + (assert date2) + (assert (> date2 date1)))))) + diff --git a/test/test1.script b/test/test1.script index ef1ed1f8c1cd8c2aef0f6082a778d37eca7df2b1..723b4a5b229d92f9cff4baa70bbd923bafd091e9 100644 --- a/test/test1.script +++ b/test/test1.script @@ -17,7 +17,7 @@ ;; 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 -f ~A" (namestring (compile-file-pathname "file2"))) (asdf:operate 'asdf:load-op 'test1) (assert (= file1-date (file-write-date (compile-file-pathname "file1")))) diff --git a/test/test3.script b/test/test3.script index 251a89b0d656367b4c3855d4bb500c7b3dfbfa54..6b6b58f6c23054320eb65b00d38178fe1e6870f4 100644 --- a/test/test3.script +++ b/test/test3.script @@ -5,7 +5,7 @@ (load "../asdf") (in-package :asdf) (cl-user::exit-on-error - (asdf:run-shell-command "rm ~A ~A" + (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*)) @@ -18,7 +18,7 @@ (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 ~A" (namestring (compile-file-pathname "file1"))) + (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")))