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

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
;;; <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
......
......@@ -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
......
......@@ -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))))
;;; -*- 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 @@
;; 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"))))
......
......@@ -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")))
......
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