From ad045f27e3ccf6ee81dee7c0104b82dcbeb4bfdf Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 21 Sep 2005 20:01:34 +0000 Subject: [PATCH] code/filesys.lisp: o Make the #p reader treat ".." as a directory, not a file. o Make the #p reader treat "<lots of dots>" be a file with that name instead of name with one fewer dot and type "". So #p"..." has :name "...", :type nil instead of :name "..", :type "". code/pathname.lisp: o Issue a warning if someone wants :name to be ".." or ".". We allow it, but doing so will break print/read consistency. (Should we make such pathnames not readably printable?) --- code/filesys.lisp | 19 +++++++++++++++---- code/pathname.lisp | 7 +++++-- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/code/filesys.lisp b/code/filesys.lisp index 2327cc0ac..e3c9b7544 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.89 2005/09/12 14:38:17 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.90 2005/09/21 20:01:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -301,14 +301,25 @@ (setf absolute t) (setf (car first) new-start)) search-list))))) - (multiple-value-bind - (name type version) + (multiple-value-bind (name type version) (let* ((tail (car (last pieces))) (tail-start (car tail)) (tail-end (cdr tail))) (unless (= tail-start tail-end) (setf pieces (butlast pieces)) - (extract-name-type-and-version namestr tail-start tail-end))) + (cond ((string= namestr ".." :start1 tail-start :end1 tail-end) + ;; ".." is a directory. Add this piece to the + ;; list of pieces, and make the name/type/version + ;; nil. + (setf pieces (append pieces (list (cons tail-start tail-end)))) + (values nil nil nil)) + ((not (find-if-not #'(lambda (c) + (char= c #\.)) + namestr :start tail-start :end tail-end)) + ;; Got a bunch of dots. Make it a file of the same name, and type nil. + (values (subseq namestr tail-start tail-end) nil nil)) + (t + (extract-name-type-and-version namestr tail-start tail-end))))) ;; PVE: Make sure there are no illegal characters in the name ;; such as #\Null and #\/. (when (and (stringp name) diff --git a/code/pathname.lisp b/code/pathname.lisp index 3e2717246..c13c69df3 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.77 2005/09/19 21:04:43 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.78 2005/09/21 20:01:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -733,7 +733,10 @@ a host-structure or string." (check-component-validity type :pathname-type) (mapc #'(lambda (d) (check-component-validity d :directory)) - (cdr dir))) + (cdr dir)) + (when (and (stringp name) + (or (string= name "..") (string= name "."))) + (warn "Silly argument for a unix PATHNAME-NAME: ~S" name))) ;; More sanity checking (when dir -- GitLab