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