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