Commit ca02fda2 authored by Robert Goldman's avatar Robert Goldman

Improve test for read dependencies.

Change the read file used to specify version and make sure INPUT-FILES
and reloading behavior reflect this properly.
parent 1ae2c79d
;;;---------------------------------------------------------------------------
;;; Sample system to test inclusion of lines from other files and
;;; correct reasoning about system modifications.
;;;---------------------------------------------------------------------------
(defsystem test-include
:version (:read-file-form "../build/random-version2.lisp-expr")
:components ((:file "file2" :in-order-to ((compile-op (load-op "file1"))
(load-op (load-op "file1"))))
(:file "file1")))
\ No newline at end of file
...@@ -8,8 +8,12 @@ ...@@ -8,8 +8,12 @@
;; I don't know what this does or when it's necessary ;; I don't know what this does or when it's necessary
;; (setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*)) ;; (setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
(defparameter *tmp-directory* (subpathname *asdf-directory* "build/")) (defparameter *tmp-directory* (subpathname *asdf-directory* "build/"))
(defparameter *test-directory* (subpathname *asdf-directory* "test/"))
(defun under-tmp-directory (designator &optional (defaults *tmp-directory*)) (defun under-tmp-directory (designator &optional (defaults *tmp-directory*))
(namestring (subpathname defaults designator))) (namestring (subpathname defaults designator)))
(defun under-test-directory (designator &optional (defaults *test-directory*))
(namestring (subpathname defaults designator)))
(defparameter *version-file* (defparameter *version-file*
(under-tmp-directory "random-version.lisp-expr")) (under-tmp-directory "random-version.lisp-expr"))
...@@ -30,6 +34,7 @@ ...@@ -30,6 +34,7 @@
;; read the initial version information correctly... ;; read the initial version information correctly...
(assert-equal (asdf:component-version system) "1.0")) (assert-equal (asdf:component-version system) "1.0"))
(DBG "*******Initial load successful*******")
(sleep 2) (sleep 2)
(DBG "*******Reloading*******") (DBG "*******Reloading*******")
;;(trace asdf/plan::action-up-to-date-p) ;;(trace asdf/plan::action-up-to-date-p)
...@@ -48,4 +53,33 @@ ...@@ -48,4 +53,33 @@
(DBG "After reload, system version is ~%" (asdf:component-version system)) (DBG "After reload, system version is ~%" (asdf:component-version system))
;; read the initial version information correctly... ;; read the initial version information correctly...
(assert-equal (asdf:component-version system) "2.0"))) (assert-equal (asdf:component-version system) "2.0")))
(sleep 2)
(DBG "*******Using new input file*******")
(let ((version-file
(under-tmp-directory "random-version2.lisp-expr")))
(unwind-protect
;; swap system definitions with different read file versions
(progn
(uiop:rename-file-overwriting-target
(under-test-directory "test-include.asd")
(under-test-directory "test-include.asd.orig"))
(uiop:copy-file
(under-test-directory "test-include2.asd")
(under-test-directory "test-include.asd"))
(with-open-file (str version-file :direction :output
:if-exists :supersede)
(format str "\"3.0\"~%"))
(asdf:load-system "test-include")
(let ((system (find-system "test-include")))
(assert-equal (asdf:component-version system) "3.0")
(assert-pathnames-equal (asdf:input-files
(asdf:make-operation 'asdf:define-op)
system)
(mapcar 'parse-namestring
(list (under-test-directory "test-include.asd")
(under-tmp-directory "random-version2.lisp-expr"))))))
(uiop:rename-file-overwriting-target
(under-test-directory "test-include.asd.orig")
(under-test-directory "test-include.asd"))
(uiop:delete-file-if-exists version-file)))
(uiop:delete-file-if-exists *version-file*)) (uiop:delete-file-if-exists *version-file*))
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