Commit 92063050 authored by Robert Goldman's avatar Robert Goldman

Fix read-dependency tests.

The third test revealed problems in test interaction with FIND-SYSTEM.
parent c5a68a2e
......@@ -5,15 +5,25 @@
;;; ---------------------------------------------------------------------------
(in-package :asdf-test)
;; I don't know what this does or when it's necessary
;; (setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*))
(defparameter *tmp-directory* (subpathname *asdf-directory* "build/"))
(defparameter *test-directory* (subpathname *asdf-directory* "test/"))
;;(defparameter *test-directory* (subpathname *asdf-directory* "test/"))
(push *test-directory* *central-registry*)
(defun under-tmp-directory (designator &optional (defaults *tmp-directory*))
(namestring (subpathname defaults designator)))
(defun under-test-directory (designator &optional (defaults *test-directory*))
(namestring (subpathname defaults designator)))
(defun copy-file-the-hard-way (source dest)
(with-open-file (sourcestr source)
(with-open-file (deststr dest :direction :output :if-exists :supersede)
(loop :for line = (read-line sourcestr nil nil)
:while line
:do (format deststr "~a~%" line))))
(values))
(defparameter *version-file*
(under-tmp-directory "random-version.lisp-expr"))
......@@ -25,8 +35,11 @@
(with-open-file (str *version-file* :direction :output
:if-exists :supersede)
(format str "\"1.0\"~%"))
(copy-file-the-hard-way (under-test-directory "test-include1.asd")
(under-test-directory "test-include.asd"))
(DBG "Set up test-include system definition:"
(probe-file (under-test-directory "test-include.asd")))
(asdf:load-system "test-include")
(let ((system (asdf:find-system "test-include")))
(DBG "On initial load, the system version is" (component-version system))
(DBG "After initial load the input files for the define op are:"
......@@ -50,7 +63,7 @@
(format str "\"2.0\"~%"))
(asdf:load-system "test-include")
(let ((system (asdf:find-system "test-include")))
(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...
(assert-equal (asdf:component-version system) "2.0")))
(sleep 2)
......@@ -60,15 +73,45 @@
(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
(copy-file-the-hard-way
(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\"~%"))
(DBG "Test-include ASDF file write date"
(uiop:safe-file-write-date (under-test-directory "test-include.asd")))
(DBG "version file write date"
(uiop:safe-file-write-date (under-tmp-directory "random-version2.lisp-expr")))
;;; the following establishes that it is NOT the fault of
;;; DEFINITION-DEPENDENCIES-UP-TO-DATE-P [2017/07/12:rpg]
#+allegro
(trace (asdf/find-system::definition-dependencies-up-to-date-p
:inside asdf:find-system)
(asdf/find-system::get-file-stamp
:inside find-system)
(asdf/find-system::stamp<=
:inside find-system))
;; AFAICT, the :WHEREIN in SBCL TRACE does not work
;; properly. In my copious free time, I should see if I
;; can find a minimal test case. [2017/07/12:rpg]
#+sbcl
(trace asdf/find-system::definition-dependencies-up-to-date-p
;; :wherein asdf:find-system
)
(DBG "operation time stamp for define-op before reload"
(asdf/action:component-operation-time
(asdf:make-operation 'define-op)
(asdf:find-system "test-include")))
;; this is NOT why this is broken on ACL...
#+ignore
(DBG "ASDF thinks the operation is done?"
(asdf:operation-done-p (make-operation 'define-op)
(find-system "test-include")))
;; (trace asdf/action:compute-action-stamp asdf:make-plan)
;; (trace asdf/plan::perform-plan asdf/plan::action-already-done-p)
(asdf:load-system "test-include")
(let ((system (find-system "test-include")))
(assert-equal (asdf:component-version system) "3.0")
......@@ -78,8 +121,6 @@
(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 (under-test-directory "test-include.asd"))
(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