Skip to content
Snippets Groups Projects
Commit 1e53a625 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Cache file timestamps by normalized namestring, not by sadly unreliable pathname.

This will hopefully make some tests more stable across implementation and operating system.
parent 1c6fecf5
No related branches found
No related tags found
No related merge requests found
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
(asdf/package:define-package :asdf/cache (asdf/package:define-package :asdf/cache
(:use :uiop/common-lisp :uiop :asdf/upgrade) (:use :uiop/common-lisp :uiop :asdf/upgrade)
(:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp (: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*)) #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
(in-package :asdf/cache) (in-package :asdf/cache)
...@@ -42,13 +42,23 @@ ...@@ -42,13 +42,23 @@
(defmacro with-asdf-cache ((&key override) &body body) (defmacro with-asdf-cache ((&key override) &body body)
`(call-with-asdf-cache #'(lambda () ,@body) :override ,override)) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override))
(defun compute-file-stamp (file) (defun normalize-namestring (pathname)
(safe-file-write-date file)) (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))) (defun compute-file-stamp (normalized-namestring)
(set-asdf-cache-entry `(get-file-stamp ,file) (list stamp))) (with-pathname-defaults ()
(safe-file-write-date normalized-namestring)))
(defun get-file-stamp (file) (defun register-file-stamp (file &optional (stamp nil stampp))
(do-asdf-cache `(get-file-stamp ,file) (compute-file-stamp file)))) (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)))))
...@@ -264,7 +264,7 @@ Some constraints: ...@@ -264,7 +264,7 @@ Some constraints:
(assert-equal (file-write-date file) stamp))))) (assert-equal (file-write-date file) stamp)))))
(defun mark-file-deleted (file) (defun mark-file-deleted (file)
(unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?")) (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) (defun hash-table->alist (table)
(loop :for key :being :the :hash-keys :of table :using (:hash-value value) (loop :for key :being :the :hash-keys :of table :using (:hash-value value)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment