Fix resolve-file to work if the cache is created at the different dev…

…ice from the original file's one.
arichiardi · Sep 14, 2019 · feb1daf · feb1daf
1 parent 8e2cc58
commit feb1daf
Showing 1 changed file with 9 additions and 10 deletions.
diff --git a/core/suite/file.lisp b/core/suite/file.lisp
@@ -22,16 +22,15 @@
       (if (eql (search (namestring asdf:*user-cache*)
                        (namestring pathname))
                0)
-          (make-pathname
-           :type "lisp"
-           :defaults pathname
-           :directory (cons :absolute
-                            (nthcdr (+ (length (pathname-directory asdf:*user-cache*))
-                                       ;; Omit also pathname-device
-                                       (if (pathname-device pathname)
-                                           1
-                                           0))
-                                    (pathname-directory pathname))))
+          (let* ((directories (nthcdr (length (pathname-directory asdf:*user-cache*))
+                                      (pathname-directory pathname)))
+                 (device (when (pathname-device pathname)
+                           (pop directories))))
+            (make-pathname
+             :type "lisp"
+             :defaults pathname
+             :device device
+             :directory (cons :absolute directories)))
           (uiop:lispize-pathname pathname)))))
 
 (defun system-component-p (system-name component-name)