From 1e53a6252e597d6545ed01dcc9277994128e85f8 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 19 Oct 2013 14:31:39 -0400
Subject: [PATCH] Cache file timestamps by normalized namestring, not by sadly
 unreliable pathname. This will hopefully make some tests more stable across
 implementation and operating system.

---
 cache.lisp               | 24 +++++++++++++++++-------
 test/script-support.lisp |  2 +-
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/cache.lisp b/cache.lisp
index 6b6bd1b0..13cbc6da 100644
--- a/cache.lisp
+++ b/cache.lisp
@@ -4,7 +4,7 @@
 (asdf/package:define-package :asdf/cache
   (:use :uiop/common-lisp :uiop :asdf/upgrade)
   (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
-           #:consult-asdf-cache #:do-asdf-cache
+           #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring
            #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
 (in-package :asdf/cache)
 
@@ -42,13 +42,23 @@
   (defmacro with-asdf-cache ((&key override) &body body)
     `(call-with-asdf-cache #'(lambda () ,@body) :override ,override))
 
-  (defun compute-file-stamp (file)
-    (safe-file-write-date file))
+  (defun normalize-namestring (pathname)
+    (let ((resolved (resolve-symlinks*
+                     (ensure-absolute-pathname
+                      (translate-logical-pathname pathname)
+                      'get-pathname-defaults))))
+      (with-pathname-defaults () (namestring resolved))))
 
-  (defun register-file-stamp (file &optional (stamp (compute-file-stamp file)))
-    (set-asdf-cache-entry `(get-file-stamp ,file) (list stamp)))
+  (defun compute-file-stamp (normalized-namestring)
+    (with-pathname-defaults ()
+      (safe-file-write-date normalized-namestring)))
 
-  (defun get-file-stamp (file)
-    (do-asdf-cache `(get-file-stamp ,file) (compute-file-stamp file))))
+  (defun register-file-stamp (file &optional (stamp nil stampp))
+    (let* ((namestring (normalize-namestring file))
+           (stamp (if stampp stamp (compute-file-stamp namestring))))
+      (set-asdf-cache-entry `(get-file-stamp ,namestring) (list stamp))))
 
+  (defun get-file-stamp (file)
+    (let ((namestring (normalize-namestring file)))
+      (do-asdf-cache `(get-file-stamp ,namestring) (compute-file-stamp namestring)))))
 
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 16d83534..8a321d22 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -264,7 +264,7 @@ Some constraints:
           (assert-equal (file-write-date file) stamp)))))
 (defun mark-file-deleted (file)
   (unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?"))
-  (acall :register-file-stamp file nil))
+  (acall :register-file-stamp (acall :normalize-namestring file) nil))
 
 (defun hash-table->alist (table)
   (loop :for key :being :the :hash-keys :of table :using (:hash-value value)
-- 
GitLab