From 6b91f3115d9e4a8dfd7497c758c36c511ccc9b27 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sun, 31 Jan 2010 16:10:35 +0000
Subject: [PATCH] Adjust TRANSLATE-DIRECTORIES to make the result be a relative
 or absolute directory according to whether the TO directory is relative or
 absolute.  Previously, the result was taken from the SOURCE directory, unless
 the TO directory was absolute.

See cmucl-help, 2010/01/29.
---
 code/pathname.lisp | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/code/pathname.lisp b/code/pathname.lisp
index b320f4f12..3a8c046ad 100644
--- a/code/pathname.lisp
+++ b/code/pathname.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.88 2009/08/13 19:23:42 rtoy Rel $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.89 2010/01/31 16:10:35 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1406,8 +1406,7 @@ a host-structure or string."
 ;;;    Called by TRANSLATE-PATHNAME on the directory components of its argument
 ;;; pathanames to produce the result directory component.  If any leaves the
 ;;; directory NIL, we return the source directory.  The :RELATIVE or :ABSOLUTE
-;;; is taken from the source directory, except if TO is :ABSOLUTE, in which
-;;; case the result will be :ABSOLUTE.
+;;; is taken from the TO directory.
 ;;;
 (defun translate-directories (source from to diddle-case)
   (if (not (and source to from))
@@ -1434,9 +1433,7 @@ a host-structure or string."
 			 (res to-part)))))
 	      (res))))
       (collect ((res))
-	(res (if (eq (first to) :absolute)
-		 :absolute
-		 (first source)))
+	(res (first to))
 	(let ((subs-left (compute-directory-substitutions (rest source)
 							  (rest from))))
 	  (dolist (to-part (rest to))
-- 
GitLab