Commit 2dc7559f authored by Gary King's avatar Gary King
Browse files

Added two tests to check that changed system definitions are reloaded by ASDF.

Modified system-definition-pathname to reload system defs even for systems
that cannot be found using one of system finders in *system-definition-search-functions*
parent 357f96d6
;;; 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 ;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical ;;; <cclan-list@lists.sf.net>. But note first that the canonical
...@@ -119,7 +119,7 @@ ...@@ -119,7 +119,7 @@
(in-package #:asdf) (in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.122 $") (defvar *asdf-revision* (let* ((v "$Revision: 1.123 $")
(colon (or (position #\: v) -1)) (colon (or (position #\: v) -1))
(dot (position #\. v))) (dot (position #\. v)))
(and v colon dot (and v colon dot
...@@ -371,8 +371,13 @@ and NIL NAME and TYPE components" ...@@ -371,8 +371,13 @@ and NIL NAME and TYPE components"
'(sysdef-central-registry-search)) '(sysdef-central-registry-search))
(defun system-definition-pathname (system) (defun system-definition-pathname (system)
(some (lambda (x) (funcall x system)) (let ((system-name (coerce-name system)))
*system-definition-search-functions*)) (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* (defvar *central-registry*
'(*default-pathname-defaults* '(*default-pathname-defaults*
...@@ -701,8 +706,7 @@ the head of the tree")) ...@@ -701,8 +706,7 @@ the head of the tree"))
(or (member (car dep) *features*) (or (member (car dep) *features*)
(error 'missing-dependency (error 'missing-dependency
:required-by c :required-by c
:requires (car dep) :requires (car dep))))
:version nil)))
(t (t
(dolist (d dep) (dolist (d dep)
(cond ((consp d) (cond ((consp d)
...@@ -1310,13 +1314,21 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -1310,13 +1314,21 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(error "RUN-SHELL-PROGRAM not implemented for this Lisp") (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
)) ))
(defun system-source-file (system-name) (defgeneric system-source-file (system)
(let ((system (asdf:find-system system-name))) (:documentation "Return the source file in which system is defined."))
(make-pathname
:type "asd" (defmethod system-source-file ((system-name t))
:name (asdf:component-name system) (system-source-file (find-system system-name)))
:defaults (asdf:component-relative-pathname system))))
(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) (defun system-source-directory (system-name)
(make-pathname :name nil (make-pathname :name nil
:type nil :type nil
......
...@@ -19,13 +19,13 @@ fi ...@@ -19,13 +19,13 @@ fi
if [ -z "$2" ]; then if [ -z "$2" ]; then
scripts="*.script" scripts="*.script"
else else
scripts="$2.script" scripts="$2"
fi fi
sok=1 sok=1
do_tests() { do_tests() {
rm *.$2 || true rm -f *.$2 || true
( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 ) ( cd .. && echo '(load "test/compile-asdf.lisp")' | $1 )
if [ $? -eq 0 ] ; then if [ $? -eq 0 ] ; then
test_count=0 test_count=0
...@@ -36,7 +36,7 @@ if [ $? -eq 0 ] ; then ...@@ -36,7 +36,7 @@ if [ $? -eq 0 ] ; then
do do
echo "Testing: $i" >&2 echo "Testing: $i" >&2
test_count=`expr "$test_count" + 1` test_count=`expr "$test_count" + 1`
rm *.$2 || true rm -f *.$2 || true
if $1 < $i ; then if $1 < $i ; then
echo "Using $1, $i passed" >&2 echo "Using $1, $i passed" >&2
test_pass=`expr "$test_pass" + 1` test_pass=`expr "$test_pass" + 1`
...@@ -76,7 +76,7 @@ if [ "$lisp" = "sbcl" ] ; then ...@@ -76,7 +76,7 @@ if [ "$lisp" = "sbcl" ] ; then
elif [ "$lisp" = "clisp" ] ; then elif [ "$lisp" = "clisp" ] ; then
if type clisp ; then if type clisp ; then
fasl_ext="fas" fasl_ext="fas"
command=`where clisp` command=`which clisp`
command="$command -norc -ansi -I - " command="$command -norc -ansi -I - "
fi fi
elif [ "$lisp" = "allegro" ] ; then elif [ "$lisp" = "allegro" ] ; then
......
...@@ -33,4 +33,4 @@ ...@@ -33,4 +33,4 @@
(leave-lisp "Script succeeded" 0)) (leave-lisp "Script succeeded" 0))
(error (c) (error (c)
(format *error-output* "~a" c) (format *error-output* "~a" c)
(leave-lisp "Script failed" 1)))) (leave-lisp "Script failed" 1))))
\ No newline at end of file
;;; -*- 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))))))
;;; -*- 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))))))
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
;; recompiled ;; recompiled
(sleep 1) ; mtime has 1-second granularity, so pause here for fast machines (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"))) (namestring (compile-file-pathname "file2")))
(asdf:operate 'asdf:load-op 'test1) (asdf:operate 'asdf:load-op 'test1)
(assert (= file1-date (file-write-date (compile-file-pathname "file1")))) (assert (= file1-date (file-write-date (compile-file-pathname "file1"))))
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
(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 ~A ~A" (asdf:run-shell-command "rm -f ~A ~A"
(namestring (compile-file-pathname "file1")) (namestring (compile-file-pathname "file1"))
(namestring (compile-file-pathname "file2"))) (namestring (compile-file-pathname "file2")))
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
(asdf:oos 'asdf:load-op 'test3) (asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file1"))) (assert (probe-file (compile-file-pathname "file1")))
(assert (not (probe-file (compile-file-pathname "file2")))) (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*))) (setf *features* (cons :f2 (cdr *features*)))
(asdf:oos 'asdf:load-op 'test3) (asdf:oos 'asdf:load-op 'test3)
(assert (probe-file (compile-file-pathname "file2"))) (assert (probe-file (compile-file-pathname "file2")))
......
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