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

Upcase path components when given a logical pathname. Preserves print/read...

Upcase path components when given a logical pathname.  Preserves print/read consistency and fixes (I think) an issue with ASDF and logical pathnames
parent 3ab45810
No related branches found
No related tags found
No related merge requests found
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.64 2004/04/01 16:26:35 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.65 2004/05/18 13:24:42 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -199,7 +199,23 @@ ...@@ -199,7 +199,23 @@
(defun %make-pathname-object (host device directory name type version) (defun %make-pathname-object (host device directory name type version)
(if (typep host 'logical-host) (if (typep host 'logical-host)
(%make-logical-pathname host :unspecific directory name type version) (flet ((upcasify (thing)
(typecase thing
(list
(mapcar #'(lambda (x)
(if (stringp x)
(string-upcase x)
x))
thing))
(simple-base-string
(string-upcase thing))
(t
thing))))
(%make-logical-pathname host :unspecific
(upcasify directory)
(upcasify name)
(upcasify type)
(upcasify version)))
(%make-pathname host device directory name type version))) (%make-pathname host device directory name type version)))
;;; *LOGICAL-HOSTS* --internal. ;;; *LOGICAL-HOSTS* --internal.
......
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