diff --git a/cache.lisp b/cache.lisp
index 13cbc6dae7564a8143a312cf3ce24f2e1390abbf..bb425e279df7c3f88220a8d1946f46704faf8bea 100644
--- a/cache.lisp
+++ b/cache.lisp
@@ -45,7 +45,7 @@
   (defun normalize-namestring (pathname)
     (let ((resolved (resolve-symlinks*
                      (ensure-absolute-pathname
-                      (translate-logical-pathname pathname)
+                      (physicalize-pathname pathname)
                       'get-pathname-defaults))))
       (with-pathname-defaults () (namestring resolved))))
 
diff --git a/find-system.lisp b/find-system.lisp
index 102be0e16bf5e10edbe0ddbac965fa3106e56d83..9268790527ad042871d0cb630412aecaa5b87ae0 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -292,7 +292,7 @@ Going forward, we recommend new users should be using the source-registry.
               (*print-readably* nil)
               (*default-pathname-defaults*
                 ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings.
-                (pathname-directory-pathname (translate-logical-pathname pathname))))
+                (pathname-directory-pathname (physicalize-pathname pathname))))
           (handler-bind
               ((error #'(lambda (condition)
                           (error 'load-system-definition-error
@@ -401,8 +401,8 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
                                             (or (pathname-equal pathname previous-pathname)
                                                 (and pathname previous-pathname
                                                      (pathname-equal
-                                                      (translate-logical-pathname pathname)
-                                                      (translate-logical-pathname previous-pathname))))
+                                                      (physicalize-pathname pathname)
+                                                      (physicalize-pathname previous-pathname))))
                                             (stamp<= stamp previous-time))))))
                   ;; only load when it's a pathname that is different or has newer content, and not an old asdf
                   (load-asd pathname :name name)))
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 4a1c86575348c07ce23a7168552e49ef4062aea1..4c36c2330a05034611f5e3f7b5ff452e938a2a61 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -84,11 +84,10 @@ do_tests () {
        scripts="$*"
   fi
   env | grep -i asdf
-  rm -f ~/.cache/common-lisp/"`pwd`"/* || true
   ## We go through great lengths to avoid " in the command line,
-  ## the quoting of which some Windows implementations get wrong.
+  ## the quoting of which many Windows implementations get wrong.
   ## While we're at it, we also avoid spaces and backslashes.
-  ( cd .. && DO $bcmd $eval '(or #.(load(string`|test/script-support.lisp|))#.(asdf-test::compile-asdf-script))' )
+  ( DO $bcmd $eval '(or`,#.(load(string`|script-support.lisp|))#.(asdf-test::compile-asdf-script))' )
   if [ $? -ne 0 ] ; then
     echo "Compilation FAILED" >&2
     echo "you can retry compilation with:" >&2
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 5767b63004c159793472f8315bdca3a00d8b948a..09db7a9b5c367fdf30222fc30acf99b1aa8ff233 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -224,7 +224,7 @@ Some constraints:
 (defun asdf-lisp (&optional tag)
   (make-pathname :name (asdf-name tag) :type "lisp" :defaults *build-directory*))
 (defun debug-lisp ()
-  (make-sub-pathname :directory (relative-dir "contrib") :name "debug" :type "lisp" :defaults *asdf-directory*))
+  (make-sub-pathname :directory (relative-dir "contrib") :name "debug" :type "lisp" :defaults *uiop-directory*))
 (defun early-compile-file-pathname (file)
   (compile-file-pathname
    (make-pathname :name (pathname-name file) :type "lisp" :defaults *early-fasl-directory*)))
diff --git a/test/stamp-propagation/test-stamp-propagation.lisp b/test/stamp-propagation/test-stamp-propagation.lisp
index 71921abd5ad90cd67bd8a506183adda604832d1b..1ffe1bdf6388d378cff59aad657ca80cdb14fa05 100644
--- a/test/stamp-propagation/test-stamp-propagation.lisp
+++ b/test/stamp-propagation/test-stamp-propagation.lisp
@@ -92,7 +92,7 @@
    "file2.lisp"))
 
 (defun reload (&optional (defsystem *default-defsystem*))
-  (format t "~&ASDF-CACHE ~S~%" asdf::*asdf-cache*)
+  (format t "~&ASDF-CACHE before ~S~%" asdf::*asdf-cache*)
   (setf *eval-notes* nil)
   (setf *compile-verbose* t *load-verbose* t)
   (ecase defsystem
@@ -118,10 +118,22 @@
      #+allegro (excl:load-system :test-stamp-propagation)
      #+lispworks (scm:load-system :test-stamp-propagation)
      #+genera (sct:load-system :test-stamp-propagation)))
+  (format t "~&ASDF-CACHE after ~S~%" asdf::*asdf-cache*)
   (let ((n (eval-notes)))
     (format t "~&EVAL-NOTES ~S~%" n)
     n))
 
+(defun clear-sys (&optional (defsystem *default-defsystem*))
+  #+asdf
+  (when (eq defsystem :asdf)
+    (asdf:clear-system :test-stamp-propagation)
+    (asdf:defsystem :test-stamp-propagation
+      :pathname #.*tsp* :source-file nil
+      :serial t
+      :components
+      ((:file "file1")
+       (:file "file2")))))
+
 (defun touch (filename)
   #+genera filename ;; TODO: do something with it!
   #-genera
@@ -140,28 +152,33 @@
    (remove '(:loading :system) log :test 'equal)
    :test 'equal :from-end t))
 
+(defun adjust-stamp-cache (base l1 f1 l2 f2)
+  (clrhash asdf::*asdf-cache*)
+  (touch-file (lisppath "file1.lisp") :timestamp base :offset l1)
+  (touch-file (faslpath "file1.lisp") :timestamp base :offset f1)
+  (dolist (l (asdf:output-files (make-instance 'asdf:compile-op)
+                                (asdf:find-component :test-stamp-propagation '("file1"))))
+    (touch-file l :timestamp base :offset f1))
+  (touch-file (lisppath "file2.lisp") :timestamp base :offset l2)
+  (touch-file (faslpath "file2.lisp") :timestamp base :offset f2)
+  (dolist (l (asdf:output-files (make-instance 'asdf:compile-op)
+                                (asdf:find-component :test-stamp-propagation '("file2"))))
+    (touch-file l :timestamp base :offset f2)))
+
 (defun test-defsystem (&optional (defsystem *default-defsystem*))
-  (format t "~&Testing stamp propagation by defsystem ~S~%" defsystem)
-  #+allegro (progn (DBG "removing any old fasls from another flavor of allegro")
-                   (clear-fasls defsystem))
+  (format t "~%~%Testing stamp propagation by defsystem ~S~%" defsystem)
+  #+(or allegro clisp)
+  (progn (DBG "removing any old fasls from another flavor of the implementation")
+         (clear-fasls defsystem))
   (when (use-cache-p defsystem)
-    (let ((tl1 (file-write-date (lisppath "file1.lisp"))))
-      (touch-file (lisppath "file1.lisp") :timestamp tl1 :offset -1000)
-      (touch-file (faslpath "file1.lisp") :timestamp tl1 :offset -10000)
-      (touch-file (lisppath "file2.lisp") :timestamp tl1 :offset -1000)
-      (touch-file (faslpath "file2.lisp") :timestamp tl1 :offset -10000)))
+    (adjust-stamp-cache (file-write-date (lisppath "file1.lisp")) -1000 -10000 -1000 -10000))
   (DBG "loading system")
   (reload defsystem)
+  (clear-sys defsystem)
   (cond
     ((use-cache-p defsystem)
      (DBG "marking all files old but first source file, and reloading")
-     (clrhash (asdf::component-operation-times (asdf:find-component :test-stamp-propagation "file1")))
-     (clrhash (asdf::component-operation-times (asdf:find-component :test-stamp-propagation "file2")))
-     (let ((tf2 (file-write-date (faslpath "file2.lisp"))))
-       (touch-file (lisppath "file1.lisp") :timestamp tf2 :offset 0)
-       (touch-file (faslpath "file1.lisp") :timestamp tf2 :offset -200)
-       (touch-file (lisppath "file2.lisp") :timestamp tf2 :offset -500)
-       (touch-file (faslpath "file2.lisp") :timestamp tf2 :offset -100)))
+     (adjust-stamp-cache (file-write-date (lisppath "file1.lisp")) 0 -1000 -1000 -1000))
     (t
      (DBG "touching first source file and reloading")
      (sleep #-os-windows 3 #+os-windows 5)
@@ -170,14 +187,11 @@
   (assert-equal (sanitize-log (reload defsystem))
                 '((:compiling :system) (:compile-toplevel :file1) (:load-toplevel :file1)
                   (:compile-toplevel :file2) (:load-toplevel :file2)))
+  (clear-sys defsystem)
   (cond
     ((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 100)
-       (touch-file (faslpath "file1.lisp") :timestamp tf2 :offset 500)
-       (touch-file (lisppath "file2.lisp") :timestamp tf2 :offset 100)
-       (touch-file (faslpath "file2.lisp") :timestamp tf2 :offset 100)))
+     (adjust-stamp-cache (file-write-date (lisppath "file1.lisp")) 100 500 100 100))
     (t
      (DBG "touching first fasl file and reloading")
      (sleep #-os-windows 3 #+os-windows 5)
diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp
index a7b634410dc83dc598fb31c3ac78b592faf46fd8..e62b1dccd1b2726f68dd57ed2ae22b7969a4351b 100644
--- a/uiop/filesystem.lisp
+++ b/uiop/filesystem.lisp
@@ -78,7 +78,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
     ;; as if the file were very old.
     ;; (or should we treat the case in a different, special way?)
     (and pathname
-         (handler-case (file-write-date (translate-logical-pathname pathname))
+         (handler-case (file-write-date (physicalize-pathname pathname))
            (file-error () nil))))
 
   (defun probe-file* (p &key truename)
@@ -100,7 +100,7 @@ or the original (parsed) pathname if it is false (the default)."
                    (if truename
                        (probe-file p)
                        (ignore-errors
-                        (let ((pp (translate-logical-pathname p)))
+                        (let ((pp (physicalize-pathname p)))
                           (and
                            #+(or cmu scl) (unix:unix-stat (ext:unix-namestring pp))
                            #+(and lispworks unix) (system:get-file-stat pp)
@@ -384,7 +384,7 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
           (unless (pathnamep p) (return nil))
           (check want-logical (logical-pathname-p p) "Expected a logical pathname")
           (check want-physical (physical-pathname-p p) "Expected a physical pathname")
-          (transform ensure-physical () (translate-logical-pathname p))
+          (transform ensure-physical () (physicalize-pathname p))
           (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
           (check want-relative (relative-pathname-p p) "Expected a relative pathname")
           (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname")
@@ -516,7 +516,7 @@ as per native OS"
     "Ensure that for every pathname in PATHNAMES, we ensure its directories exist"
     (dolist (pathname pathnames)
       (when pathname
-        (ensure-directories-exist (translate-logical-pathname pathname)))))
+        (ensure-directories-exist (physicalize-pathname pathname)))))
 
   (defun rename-file-overwriting-target (source target)
     "Rename a file, overwriting any previous file with the TARGET name,
diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp
index 8d1a7a0a51204526776cc63292d0556d9196c9cd..062b33b0df144869c4e56e137fadae1950a8ae50 100644
--- a/uiop/pathname.lisp
+++ b/uiop/pathname.lisp
@@ -15,7 +15,7 @@
    #:merge-pathnames*
    #:nil-pathname #:*nil-pathname* #:with-pathname-defaults
    ;; Predicates
-   #:pathname-equal #:logical-pathname-p #:physical-pathname-p
+   #:pathname-equal #:logical-pathname-p #:physical-pathname-p #:physicalize-pathname
    #:absolute-pathname-p #:relative-pathname-p #:hidden-pathname-p #:file-pathname-p
    ;; Directories
    #:pathname-directory-pathname #:pathname-parent-directory-pathname
@@ -181,6 +181,20 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
                           :type (funcall unspecific-handler type)
                           :version (funcall unspecific-handler version))))))
 
+  (defun logical-pathname-p (x)
+    "is X a logical-pathname?"
+    (typep x 'logical-pathname))
+
+  (defun physical-pathname-p (x)
+    "is X a pathname that is not a logical-pathname?"
+    (and (pathnamep x) (not (logical-pathname-p x))))
+
+  (defun physicalize-pathname (x)
+    "if X is a logical pathname, use translate-logical-pathname on it."
+    ;; Ought to be the same as translate-logical-pathname, except the latter borks on CLISP
+    (let ((p (when x (pathname x))))
+      (if (logical-pathname-p p) (translate-logical-pathname p) p)))
+
   (defun nil-pathname (&optional (defaults *default-pathname-defaults*))
     "A pathname that is as neutral as possible for use as defaults
 when merging, making or parsing pathnames"
@@ -197,7 +211,7 @@ when merging, making or parsing pathnames"
                        ;; the default shouldn't matter, but we really want something physical
                        #-mcl ,@'(:defaults defaults)))
 
-  (defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname)))
+  (defvar *nil-pathname* (nil-pathname (physicalize-pathname (user-homedir-pathname)))
     "A pathname that is as neutral as possible for use as defaults
 when merging, making or parsing pathnames")
 
@@ -230,14 +244,6 @@ when merging, making or parsing pathnames"
                       (=? pathname-type)
                       (=? pathname-version)))))))
 
-  (defun logical-pathname-p (x)
-    "is X a logical-pathname?"
-    (typep x 'logical-pathname))
-
-  (defun physical-pathname-p (x)
-    "is X a pathname that is not a logical-pathname?"
-    (and (pathnamep x) (not (logical-pathname-p x))))
-
   (defun absolute-pathname-p (pathspec)
     "If PATHSPEC is a pathname or namestring object that parses as a pathname
 possessing an :ABSOLUTE directory component, return the (parsed) pathname.