From c0715083ec3d2ec22a6be213da2b28e0ac2217c7 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Fri, 30 Sep 2005 15:44:19 +0000
Subject: [PATCH] parse-unix-namestring: o Don't allow a namestring to be
 parsed as a search-list if a logical   host with the same host name already
 exists.  Allowing this causes   confusing in printing such pathnames because,
 when read, the logical   host takes precedence.

unparse-unix-file:
o Preserve version :NEWEST when printing out logical pathnames.  This
  makes #p"host:foo.bar.newest" readable.
---
 code/filesys.lisp | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/code/filesys.lisp b/code/filesys.lisp
index 65569a396..325fc6e97 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.92 2005/09/25 21:47:48 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.93 2005/09/30 15:44:19 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -306,6 +306,13 @@
 		     (maybe-extract-search-list namestr
 						(car first) (cdr first))
 		   (when search-list
+		     ;; Lose if this search-list is already defined as
+		     ;; a logical host.  Since the syntax for
+		     ;; search-lists and logical pathnames are the
+		     ;; same, we can't allow the creation of one when
+		     ;; the other is defined.
+		     (when (find-logical-host search-list nil)
+		       (error "~A already names a logical host" search-list))
 		     (setf absolute t)
 		     (setf (car first) new-start))
 		   search-list)))))
@@ -476,9 +483,12 @@
 	   (type-supplied (not (or (null type) (eq type :unspecific))))
 	   (logical-p (logical-pathname-p pathname))
 	   (version (%pathname-version pathname))
+	   ;; Preserve version :newest for logical pathnames.
 	   (version-supplied (not (or (null version)
-				      (member version '(:newest
-							:unspecific))))))
+				      (member version (if logical-p
+							  '(:unspecific)
+							  '(:newest
+							    :unspecific)))))))
       (when name
 	(strings (unparse-unix-piece name)))
       (when type-supplied
@@ -494,7 +504,7 @@
       (when version-supplied
 	(strings (if (eq version :wild)
 		     (if logical-p ".*" ".~*~")
-		     (format nil (if logical-p ".~D" ".~~~D~~")
+		     (format nil (if logical-p ".~A" ".~~~D~~")
 			     version)))))
     (and (strings) (apply #'concatenate 'simple-string (strings)))))
 
-- 
GitLab