Skip to content
Snippets Groups Projects
Commit c0715083 authored by rtoy's avatar rtoy
Browse files

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.
parent f629b245
No related branches found
No related tags found
No related merge requests found
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -306,6 +306,13 @@
(maybe-extract-search-list namestr (maybe-extract-search-list namestr
(car first) (cdr first)) (car first) (cdr first))
(when search-list (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 absolute t)
(setf (car first) new-start)) (setf (car first) new-start))
search-list))))) search-list)))))
...@@ -476,9 +483,12 @@ ...@@ -476,9 +483,12 @@
(type-supplied (not (or (null type) (eq type :unspecific)))) (type-supplied (not (or (null type) (eq type :unspecific))))
(logical-p (logical-pathname-p pathname)) (logical-p (logical-pathname-p pathname))
(version (%pathname-version pathname)) (version (%pathname-version pathname))
;; Preserve version :newest for logical pathnames.
(version-supplied (not (or (null version) (version-supplied (not (or (null version)
(member version '(:newest (member version (if logical-p
:unspecific)))))) '(:unspecific)
'(:newest
:unspecific)))))))
(when name (when name
(strings (unparse-unix-piece name))) (strings (unparse-unix-piece name)))
(when type-supplied (when type-supplied
...@@ -494,7 +504,7 @@ ...@@ -494,7 +504,7 @@
(when version-supplied (when version-supplied
(strings (if (eq version :wild) (strings (if (eq version :wild)
(if logical-p ".*" ".~*~") (if logical-p ".*" ".~*~")
(format nil (if logical-p ".~D" ".~~~D~~") (format nil (if logical-p ".~A" ".~~~D~~")
version))))) version)))))
(and (strings) (apply #'concatenate 'simple-string (strings))))) (and (strings) (apply #'concatenate 'simple-string (strings)))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment