From afe77f2a07f308fb0f5e403830f2b9030cd7f053 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Wed, 5 Oct 2005 12:54:28 +0000
Subject: [PATCH] Fix a couple of issues with ENOUGH-NAMESTRING not returning
 the shortest namestring:

(enough-namestring #p"/foo" #p"/") => "foo", not "./foo"
(enough-namestring #p"foo/bar" #p"foo/") => "bar", not "foo/bar"

We check for a common prefix for all cases first now, instead of just
when the pathname is :absolute.
---
 code/filesys.lisp | 26 +++++++++++++++++++-------
 1 file changed, 19 insertions(+), 7 deletions(-)

diff --git a/code/filesys.lisp b/code/filesys.lisp
index 325fc6e97..a06060373 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.93 2005/09/30 15:44:19 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.94 2005/10/05 12:54:28 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -534,17 +534,29 @@
 			 ;; shorter namestring.
 			 #+nil (list :relative)
 			 nil)
-			((eq (first pathname-directory) :relative)
-			 ;; Relative directory so relative to default.
-			 pathname-directory)
 			((and (>= prefix-len 1)
 			      (>= (length pathname-directory) prefix-len)
 			      (compare-component (subseq pathname-directory
 							 0 prefix-len)
 						 defaults-directory))
-			 ;; Pathname starts with a prefix of default.  So just
-			 ;; use a relative directory from then on out.
-			 (cons :relative (nthcdr prefix-len pathname-directory)))
+			 ;; Pathname starts with a prefix of default,
+			 ;; which also means both are either :relative
+			 ;; or :absolute directories.  So just use a
+			 ;; relative directory from then on out.
+			 (let ((dir-tail (nthcdr prefix-len pathname-directory)))
+			   ;; If both directories are identical, don't
+			   ;; return just :relative.  Returning NIL
+			   ;; results in a shorter string.
+			   (if dir-tail
+			       (cons :relative dir-tail)
+			       nil)))
+			((and (eq (car pathname-directory) :relative)
+			      (not (eq (car defaults-directory) :absolute)))
+			 ;; Can't represent a relative directory
+			 ;; relative to an absolute directory.  But
+			 ;; there's no problem if both are relative;
+			 ;; we just return our path.
+			 pathname-directory)
 			((eq (car pathname-directory) :absolute)
 			 ;; We are an absolute pathname, so we can just use it.
 			 pathname-directory)
-- 
GitLab