diff --git a/TODO b/TODO
index 71cd0b37fe475c6168dcfc849fe8fbc1cf46553f..97ff02e9a2166ce1c1600e54ba43b7eb3fb7aa15 100644
--- a/TODO
+++ b/TODO
@@ -113,6 +113,7 @@
 *** it somehow pushes :non-base-chars-exist-p even though +non-base-chars-exist-p+ is NIL???
 
 ** XCL has bad bugs:
+*** it can't compile ASDF3 anymore. Figure out why, if you have time.
 *** make-pathname doesn't handle :type nil properly and
     has massive lossage in logical-pathname support.
 *** If using block () and return in search-for-system-definition
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 4496c9a6618672c2dab5179eb3a559b9700fd6f6..fae5cf49fda900956d4c7f5c5e3d9220b70d8290 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -168,14 +168,14 @@ Some constraints:
         qx x (pathname-components x)
         qy y (pathname-components y)))
     ;; accept equalp namestrings, to account for case-independent filesystems
-    ((equalp (namestring x) (namestring y))
+    ((equalp (and x (namestring x)) (and y (namestring y)))
      (warn "These two expressions yield pathnames that have equalp namestrings yet are not pathname-equal~%~
         the first expression ~S yields this:~%  ~S~%  ~S~%
         the other expression ~S yields that:~%  ~S~%  ~S~%"
         qx x (pathname-components x)
         qy y (pathname-components y)))
     (t
-     (error "These two expressions yield paths that are equal in any way:~%~
+     (error "These two expressions yield paths that are not equal in any way:~%~
         the first expression ~S yields this:~%  ~S~%  ~S~%
         the other expression ~S yields that:~%  ~S~%  ~S~%"
         qx x (pathname-components x)
diff --git a/test/test-utilities.script b/test/test-utilities.script
index e0008b2af8152d9b43f1fec02c89852cec5d3155..a523b15ab7f3aa88445b64d14c4226ddf6099778 100755
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -1,6 +1,7 @@
 ;;; -*- Lisp -*-
 
 #+(and sbcl os-windows) (trace sb-ext:run-program)
+(proclaim '(optimize (debug 3) (speed 1) (safety 3) (compilation-speed 0)))
 
 (defun getcwd-from-run-program ()
   (uiop:parse-native-namestring
@@ -14,19 +15,93 @@
      :output '(:string :stripped t)))
    :ensure-directory t))
 
-(let ((asdf-directory (truename *asdf-directory*)))
-  (chdir asdf-directory)
-  (assert-pathname-equal asdf-directory (getcwd))
-  #-(and sbcl os-windows)
-  (assert-pathname-equal asdf-directory (getcwd-from-run-program))
-  (assert (probe-file* "asdf.asd")))
-
-(let ((test-directory (truename *test-directory*)))
-  (chdir test-directory)
-  (assert-pathname-equal test-directory (getcwd))
-  #-(and sbcl os-windows)
-  (assert-pathname-equal test-directory (getcwd-from-run-program))
-  (assert (probe-file* "test-utilities.script")))
+(let ((asdf-directory (truename *asdf-directory*))
+      (test-directory (truename *test-directory*)))
+  (labels ((check-cwd (dir)
+             (assert-pathname-equal dir (getcwd))
+             #-(and sbcl os-windows)
+             (assert-pathname-equal dir (getcwd-from-run-program)))
+           (check-true-dpd (dir)
+             (assert-pathname-equal dir (get-pathname-defaults))
+             (assert-pathname-equal dir (truename #p"./"))
+             (assert-pathname-equal dir (truename* #p"./")))
+           (check-file-exists (file &optional true)
+             (setf file (parse-unix-namestring file))
+             (if true
+                 (assert-pathname-equal true (probe-file file))
+                 (setf true (probe-file file)))
+             (assert-pathname-equal true (truename file))
+             (assert-pathname-equal true (truename* file))
+             (assert-pathname-equal true (probe-file* file :truename t))
+             (assert-pathname-equal true (ensure-absolute-pathname (probe-file* file) 'get-pathname-defaults)))
+           (check-file-doesnt-exist (file)
+             (setf file (parse-unix-namestring file))
+             (assert-equal nil (probe-file* file))
+             (assert-equal nil (probe-file file)))
+           (check-directory-exists (file &optional true)
+             (setf file (parse-unix-namestring file))
+             (let ((dir (truename (ensure-directory-pathname file))))
+               (if true
+                   (assert-pathname-equal true dir)
+                   (setf true dir)))
+             (assert-pathname-equal true (truename (ensure-directory-pathname file)))
+             (assert-pathname-equal true (truename* file))
+             (assert-pathname-equal true (nest #+allegro (ensure-directory-pathname) (probe-file* file :truename t)))
+             (assert-pathname-equal true (if-let (x (probe-file* file))
+                                           (ensure-absolute-pathname (ensure-directory-pathname x) 'get-pathname-defaults))))
+           (check-directory-doesnt-exist (file)
+             (setf file (parse-unix-namestring file))
+             (assert-equal nil (probe-file* file)))
+           (check-true-dpd-asdf ()
+             (check-true-dpd asdf-directory)
+             (check-file-exists "asdf.asd")
+             (check-file-exists "test/test-utilities.script")
+             (check-directory-exists "tools/")
+             (check-directory-exists "tools")
+             (check-file-doesnt-exist "test-utilities.script")
+             (check-directory-doesnt-exist "stamp-propagation/"))
+           (check-true-dpd-test ()
+             (check-true-dpd test-directory)
+             (check-file-exists "test-utilities.script")
+             (check-directory-exists "stamp-propagation/")
+             (check-directory-exists "stamp-propagation")
+             (check-file-doesnt-exist "test/test-utilities.script")
+             (check-directory-doesnt-exist "tools/")))
+
+    (DBG "1" (chdir asdf-directory) (setf *default-pathname-defaults* asdf-directory))
+    (check-true-dpd-asdf)
+
+    (DBG "2" (chdir test-directory) (setf *default-pathname-defaults* test-directory))
+    (check-true-dpd-test)
+
+    (with-expected-failure (#+gcl t)
+      (DBG "3" (chdir asdf-directory) (setf *default-pathname-defaults* test-directory))
+      (check-true-dpd-test))
+
+    #-(or abcl genera xcl) ;; on these platforms, chdir changes D-P-D so these tests are not meaningful
+    (progn
+      ;; SBCL hates to get (truename #p"") when D-P-D is itself #p"". See https://bugs.launchpad.net/sbcl/+bug/1472414
+      (DBG "4"
+           (setf *default-pathname-defaults* (nil-pathname)) ;; make things relative to GETCWD
+           (chdir asdf-directory)) ;; note: may or may not change *default-pathname-defaults* to an absolute pathname.
+      (check-true-dpd-asdf)
+      (DBG "5"
+           *default-pathname-defaults*
+           (chdir test-directory)) ;; note: may or may not change *default-pathname-defaults* to an absolute pathname.
+      (check-true-dpd-test)
+
+      ;; On implementations where chdir doesn't side-effect D-P-D, we can have D-P-D be relative to GETCWD...
+      ;; except on allegro, that hates this trick.
+      (with-expected-failure (#+(or allegro gcl) t)
+        (unless (absolute-pathname-p *default-pathname-defaults*)
+          (DBG "6"
+               (chdir asdf-directory)
+               (setf *default-pathname-defaults* (parse-unix-namestring "test/")))
+          (check-true-dpd-test))))
+
+    ;; For the rest of this test, use these:
+    (setf *default-pathname-defaults* (nil-pathname))
+    (chdir test-directory)))
 
 (assert
  (every #'directory-pathname-p
diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp
index 94b63a99a871f60940d8b607e1306d15f7f27964..f8cbebf595bfa86ede96003be4f5fb800d725ff3 100644
--- a/uiop/filesystem.lisp
+++ b/uiop/filesystem.lisp
@@ -64,9 +64,12 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
 ;;; Probing the filesystem
 (with-upgradability ()
   (defun truename* (p)
-    "Nicer variant of TRUENAME that plays well with NIL and avoids logical pathname contexts"
-    ;; avoids both logical-pathname merging and physical resolution issues
-    (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil))))
+    "Nicer variant of TRUENAME that plays well with NIL, avoids logical pathname contexts, and tries both files and directories"
+    (when p
+      (when (stringp p) (setf p (with-pathname-defaults () (parse-namestring p))))
+      (values
+       (or (ignore-errors (truename p))
+           #+(or clisp gcl) (if-let (d (ensure-directory-pathname p)) (ignore-errors (truename d)))))))
 
   (defun safe-file-write-date (pathname)
     "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error."
@@ -87,60 +90,54 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
 probes the filesystem for a file or directory with given pathname.
 If it exists, return its truename is ENSURE-PATHNAME is true,
 or the original (parsed) pathname if it is false (the default)."
-    (etypecase p
-      (null nil)
-      (string
-       ;; avoid logical-pathname issues on some implementations
-       (let ((pn (with-pathname-defaults () (parse-namestring p))))
-	 (probe-file* pn :truename truename)))
-      (pathname
-       (and (not (wild-pathname-p p))
-	    (handler-case
-		(or
-		 #+allegro
-		 (probe-file p :follow-symlinks truename)
-		 #+gcl
-		 (if truename
-		   (truename* p)
-		   (let ((kind (car (si::stat p))))
-		     (when (eq kind :link)
-		       (setf kind (ignore-errors (car (si::stat (truename* p))))))
-		     (ecase kind
-		       ((nil) nil)
-		       ((:file :link)
-			(cond
-			  ((file-pathname-p p) p)
-			  ((directory-pathname-p p)
-			   (subpathname p (car (last (pathname-directory p)))))))
-		       (:directory (ensure-directory-pathname p)))))
-		 #+clisp
-		 #.(let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))
-			  (pp (find-symbol* '#:probe-pathname :ext nil)))
-		       `(if truename
-			  ,(if pp
-			     `(ignore-errors (,pp p))
-			     '(or (truename* p)
-			       (truename* (ignore-errors (ensure-directory-pathname p)))))
-			  ,(cond
-			     (fs `(and (ignore-errors (,fs p)) p))
-			     (pp `(ignore-errors (nth-value 1 (,pp p))))
-			     (t '(if-let (q (ensure-absolute-pathname p
-					     :defaults 'get-pathname-defaults :on-error nil))
-				  (or (and (truename* q) q)
-				   (if-let (d (ignore-errors (ensure-directory-pathname q)))
-				     (and (truename* d) d))))))))
-		 #-(or allegro clisp gcl)
-		 (if truename
-		   (probe-file p)
-		   (ignore-errors
-		    (let ((pp (physicalize-pathname p)))
-		      (and
-		       #+(or cmu scl) (unix:unix-stat (ext:unix-namestring pp))
-		       #+(and lispworks unix) (system:get-file-stat pp)
-		       #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring pp))
-		       #-(or cmu (and lispworks unix) sbcl scl) (file-write-date pp)
-		       p)))))
-	      (file-error () nil))))))
+    (values
+     (ignore-errors
+      (setf p (funcall 'ensure-pathname p
+                       :namestring :lisp
+                       :ensure-physical t
+                       :ensure-absolute t :defaults 'get-pathname-defaults
+                       :want-non-wild t
+                       :on-error nil))
+      (when p
+        #+allegro
+        (probe-file p :follow-symlinks truename)
+        #+gcl
+        (if truename
+            (truename* p)
+            (let ((kind (car (si::stat p))))
+              (when (eq kind :link)
+                (setf kind (ignore-errors (car (si::stat (truename* p))))))
+              (ecase kind
+                ((nil) nil)
+                ((:file :link)
+                 (cond
+                   ((file-pathname-p p) p)
+                   ((directory-pathname-p p)
+                    (subpathname p (car (last (pathname-directory p)))))))
+                (:directory (ensure-directory-pathname p)))))
+        #+clisp
+        #.(let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))
+                 (pp (find-symbol* '#:probe-pathname :ext nil)))
+            `(if truename
+                 ,(if pp
+                      `(values (,pp p))
+                      '(or (truename* p)
+                        (truename* (ignore-errors (ensure-directory-pathname p)))))
+                 ,(cond
+                    (fs `(and (,fs p) p))
+                    (pp `(nth-value 1 (,pp p)))
+                    (t '(or (and (truename* p) p)
+                         (if-let (d (ensure-directory-pathname p))
+                          (and (truename* d) d)))))))
+        #-(or allegro clisp gcl)
+        (if truename
+            (probe-file p)
+            (and
+             #+(or cmu scl) (unix:unix-stat (ext:unix-namestring p))
+             #+(and lispworks unix) (system:get-file-stat p)
+             #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring p))
+             #-(or cmu (and lispworks unix) sbcl scl) (file-write-date p)
+             p))))))
 
   (defun directory-exists-p (x)
     "Is X the name of a directory that exists on the filesystem?"