Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
;;; 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")))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment