From 44aa97ed64da5bf00b3235a542f950511d16da5d Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sun, 20 Oct 2013 02:08:31 -0400 Subject: [PATCH] Make test-stamp-propagation succeed (at failing!) on ASDF 2.26, and more reliably work with ASDF3. --- test/script-support.lisp | 9 +++++---- .../test-stamp-propagation.lisp | 17 ++++++++++------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/test/script-support.lisp b/test/script-support.lisp index 8a321d22..5767b630 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -88,6 +88,7 @@ Some constraints: (when errorp (error "Can't find package ~A" pname))))) (defun acall (name &rest args) (apply (apply 'asym (if (consp name) name (list name))) args)) +(defun ucall (name &rest args) (apply (asym name :uiop) args)) (defun asymval (name &optional package) (symbol-value (asym name package))) (defsetf asymval (name &optional package) (new-value) ;; NB: defun setf won't work on GCL2.6 @@ -147,7 +148,7 @@ Some constraints: (cond ((equal x y) (format t "~S and ~S both evaluate to same path:~% ~S~%" qx qy x)) - ((acall :pathname-equal x y) + ((ucall :pathname-equal x y) (warn "These two expressions yield pathname-equal yet not equal path~%~ the first expression ~S yields this:~% ~S~% ~S~% the other expression ~S yields that:~% ~S~% ~S~%" @@ -257,10 +258,10 @@ Some constraints: (decode-universal-time stamp #+gcl2.6 -5) ;; -5 is for *my* localtime (unless in-filesystem (error "Y U NO use stamp cache?")) - (acall :run-program + (ucall :run-program `("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D" year month day hr min sec) - ,(acall :native-namestring file))) + ,(ucall :native-namestring file))) (assert-equal (file-write-date file) stamp))))) (defun mark-file-deleted (file) (unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?")) @@ -325,7 +326,7 @@ is bound, write a message and exit on an error. If (break)) (t (ignore-errors - (acall :print-condition-backtrace + (ucall :print-condition-backtrace c :count 69 :stream *error-output*)) (leave-test "Script failed" 1)))))) (funcall (or (asym :call-with-asdf-cache) 'funcall) thunk) diff --git a/test/stamp-propagation/test-stamp-propagation.lisp b/test/stamp-propagation/test-stamp-propagation.lisp index fd6316db..964af207 100644 --- a/test/stamp-propagation/test-stamp-propagation.lisp +++ b/test/stamp-propagation/test-stamp-propagation.lisp @@ -9,7 +9,8 @@ (unless (find-package :asdf) (asdf-test::load-asdf) - (asdf-test::frob-packages)) + (asdf-test::frob-packages) + (use-package :uiop :asdf)) (in-package :asdf-test) @@ -125,7 +126,7 @@ (defun touch (filename) #+genera filename ;; TODO: do something with it! #-genera - (uiop:run-program `("touch" ,(native-namestring filename)) + (uiop:run-program `("touch" ,(uiop:native-namestring filename)) :output t :error-output t)) (defun clear-fasls (&optional (defsystem *default-defsystem*)) @@ -166,10 +167,10 @@ ((use-cache-p defsystem) (DBG "marking the old fasl new, the second one up to date") (let ((tf2 (file-write-date (faslpath "file2.lisp")))) - (touch-file (lisppath "file1.lisp") :timestamp tf2 :offset 0) + (touch-file (lisppath "file1.lisp") :timestamp tf2 :offset 100) (touch-file (faslpath "file1.lisp") :timestamp tf2 :offset 500) - (touch-file (lisppath "file2.lisp") :timestamp tf2 :offset 0) - (touch-file (faslpath "file2.lisp") :timestamp tf2 :offset 0))) + (touch-file (lisppath "file2.lisp") :timestamp tf2 :offset 100) + (touch-file (faslpath "file2.lisp") :timestamp tf2 :offset 100))) (t (DBG "touching first fasl file and reloading") (sleep #-os-windows 3 #+os-windows 5) @@ -182,8 +183,10 @@ (clear-fasls defsystem)) -#-(or abcl xcl) ;; TODO: figure out why ABCL and XCL fail to recompile anything. -(test-defsystem :asdf) +(cond + #+(and asdf3 (not abcl) (not xcl)) ;; TODO: figure out why ABCL and XCL fail to recompile anything. + (t (test-defsystem :asdf)) + (t (signals error (test-defsystem :asdf)))) #+(or genera lispworks) (test-defsystem :native) -- GitLab