[Openmcl-devel] Handling of :CASE :COMMON in MAKE-PATHNAME

[Richard M Kreuter]

Hi,

Using the 1.2-r9226-RC1 snapshot, I see the following when calling
MAKE-PATHNAME with :CASE :COMMON:

? (make-pathname :case :common :name "ABC"
                 :defaults (user-homedir-pathname))
#P"/HOME/KREUTER/abc"

That is, case conversion is being performed on fields filled in from
the DEFAULTS argument.  ISTM that MAKE-PATHNAME shouldn't perform case
conversion on components it fills in from DEFAULTS, for two reasons:

(1) those components are filled in under the rules used by
MERGE-PATHNAMES, and MERGE-PATHNAMES doesn't frob case:

? (merge-pathnames (make-pathname :name "ABC" :case :common)
                   (user-homedir-pathname))
#P"/home/kreuter/abc"

(2) 19.2.2.1.2.1 and 19.2.2.1.2.2 describes the behavior of various
    functions when receiving strings, and the :DEFAULTS argument to
    MAKE-PATHNAME isn't a string argument per se.

The following patch should ensure that any case conversion is only
carried out on arguments supplied to MAKE-PATHNAME, before filling the
new pathname's components from the defaults.

Thanks,
Richard Kreuter

--- l1-files.lisp.orig	2008-04-20 09:35:15.000000000 -0400
+++ l1-files.lisp	2008-04-29 17:24:55.000000000 -0400
@@ -546,6 +546,10 @@
 		   (pathname-host defaulted-defaults)
 		   :unspecific)))
     (unless host (setq host :unspecific)))
+  (when (and case (neq case :local))
+    (setf directory (%reverse-component-case directory case)
+          name (%reverse-component-case name case)
+          type (%reverse-component-case type case)))
   (if directory-p 
     (setq directory (%std-directory-component directory host)))
   (if (and defaults (not directory-p))
@@ -576,11 +580,6 @@
   (let* ((after-wif (cadr (member :wild-inferiors directory))))
     (when (member after-wif '(:up :back))
           (error 'simple-file-error :pathname path :error-type "Directory component in ~s contains :WILD-INFERIORS followed by ~s" :format-arguments (list after-wif))))
-	 
-  (when (and case (neq case :local))
-    (setf (%pathname-directory path) (%reverse-component-case (%pathname-directory path) case)
-          (%pathname-name path) (%reverse-component-case (%pathname-name path) case)
-          (%pathname-type path) (%reverse-component-case (%pathname-type path) case)))
   path)
 
 ;;;  In portable CL, if the :directory argument to make pathname is a