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