From aa0ffd5889b779a6d027f6f3bf244ca0e1c29951 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sat, 19 Oct 2013 19:40:16 -0400 Subject: [PATCH] Make stamp propagation test more robust, thanks to Dave Cooper. --- .../test-stamp-propagation.lisp | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/test/stamp-propagation/test-stamp-propagation.lisp b/test/stamp-propagation/test-stamp-propagation.lisp index 5d02ca4b..eb7a8b47 100644 --- a/test/stamp-propagation/test-stamp-propagation.lisp +++ b/test/stamp-propagation/test-stamp-propagation.lisp @@ -114,10 +114,23 @@ (defun touch-file1.lisp () (touch (asdf::subpathname *tsp* "file1.lisp"))) +(defun faslpath (lisppath &optional (defsystem *default-defsystem*)) + (funcall + (if (and (eq defsystem :asdf) (fboundp 'asdf::compile-file-pathname*)) + 'asdf::compile-file-pathname* + 'compile-file-pathname) + lisppath)) + +(defun clear-fasls (&optional (defsystem *default-defsystem*)) + (loop :for file :in '("file1.lisp" "file2.lisp") + :for lisppath = (asdf::subpathname *tsp* file) + :for faslpath = (faslpath lisppath defsystem) + :do (if (and (eq defsystem :asdf) asdf::*asdf-cache*) + (mark-file-deleted faslpath) + (delete-file-if-exists faslpath)))) + (defun touch-file1.fasl (&optional (defsystem *default-defsystem*)) - (touch (funcall - (case defsystem (:asdf 'asdf::compile-file-pathname*) (t 'compile-file-pathname)) - (asdf::subpathname *tsp* "file1.lisp")))) + (touch (faslpath (asdf::subpathname *tsp* "file1.lisp") defsystem))) (defun sanitize-log (log) (remove-duplicates @@ -126,6 +139,8 @@ (defun test-defsystem (&optional (defsystem *default-defsystem*)) (format t "~&Testing stamp propagation by defsystem ~S~%" defsystem) + (DBG "removing any old fasls") + (clear-fasls defsystem) (DBG "loading system") (reload defsystem) (sleep 2) ;; TODO: on ASDF at least, instead touch the file stamp with the cache. @@ -141,7 +156,10 @@ (touch-file1.fasl defsystem) (assert-equal (sanitize-log (reload defsystem)) '((:compiling :system) (:load-toplevel :file1) - (:compile-toplevel :file2) (:load-toplevel :file2)))) + (:compile-toplevel :file2) (:load-toplevel :file2))) + (DBG "cleaning up") + (clear-fasls defsystem)) + #-(or abcl xcl) ;; TODO: figure out why ABCL and XCL fail to recompile anything. (test-defsystem :asdf) -- GitLab