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