Changeset 15293

Timestamp:

Apr 4, 2012, 12:17:50 PM (13 years ago)

Author:

gz

Message:

Force host in backtranslated pathname

File:

• trunk/source/lib/pathnames.lisp (modified) (1 diff)

trunk/source/lib/pathnames.lisp

@@ -58 +58 @@
       (dolist (trans (cdr host))
         (when (pathname-match-p path (cadr trans))
-          (let* (newpath)          
-            (setq newpath (translate-pathname path (cadr trans) (car trans) :reversible t))
+          (let* ((src (car trans)) newpath)
+            ;; Force host in backtranslated path
+            (when (null (pathname-host src))
+              (setq src (make-pathname :host (car host) :defaults src)))
+            (setq newpath (translate-pathname path (cadr trans) src :reversible t))
             (return-from back-translate-pathname-1 
               (if  (equalp path newpath) path (back-translate-pathname-1 newpath hosts))))))))