CCLでUCNのパス

patch

Index: level-1/l1-files.lisp
===================================================================
--- level-1/l1-files.lisp	(revision 12400)
+++ level-1/l1-files.lisp	(working copy)
@@ -700,7 +700,11 @@
     (t (cond ((string= name "*") :wild)
              ((string= name "**") :wild-inferiors)
 	     ((string= name "..") :up)
-             (t (%path-std-quotes name "/:;*" "/:;"))))))
+             (t
+              #-windows-target
+              (%path-std-quotes name "/:;*" "/:;")
+              #+windows-target
+              name)))))
 
 ; this will allow creation of garbage pathname "foo:bar;bas:" do we care?
 (defun merge-pathnames (path &optional (defaults *default-pathname-defaults*)
@@ -878,6 +882,13 @@
                          (when pos
                            (split sstr (%i+ pos 1) end))))))))
     (unless (eq start end)
+      #+windows-target
+      (if (eql 0 (search "//" sstr))
+          (let ((dirs (split sstr start end)))
+            (return-from %directory-string-list
+              (cons :absolute
+                    (cons (concatenate 'string "/" (car dirs))
+                          (cdr dirs))))))
       (let* ((slash-pos (%path-mem "/" sstr start end))
 	     (semi-pos (%path-mem ";" sstr start end))
 	     (pos (or slash-pos semi-pos)))
Index: level-1/l1-reader.lisp
===================================================================
--- level-1/l1-reader.lisp	(revision 12400)
+++ level-1/l1-reader.lisp	(working copy)
@@ -3157,7 +3157,11 @@
     (let* ((cur-pos (file-position stream))
            (noctets (- end-offset start-offset))
            (vec (make-array noctets :element-type '(unsigned-byte 8)))
-           (index 0))
+           (index 0)
+           (crlfp (eq :crlf
+                      (cdr (assoc (external-format-line-termination
+                                   (stream-external-format stream))
+                                  *canonical-line-termination-conventions*)))))
       (declare (type fixnum end-offset noctets index)
                (type (simple-array (unsigned-byte 8) (*)) vec))
       (macrolet ((out (code)
@@ -3168,8 +3172,11 @@
         (loop
           (let ((code (char-code (stream-read-char stream))))
             (declare (fixnum code))
-            (cond ((< code #x80)
+            (cond ((= code #x0a)
+                   (when crlfp (out #x0d))
                    (out code))
+                  ((< code #x80)
+                   (out code))
                   ((< code #x800)
                    (out (logior #xc0 (ldb (byte 5 6) code)))
                    (out (logior #x80 (ldb (byte 6 0) code))))
Index: lib/pathnames.lisp
===================================================================
--- lib/pathnames.lisp	(revision 12400)
+++ lib/pathnames.lisp	(working copy)
@@ -216,11 +216,12 @@
 		   :error-type "Can't create directory ~s, since file ~a exists and is not a directory"
 		   :pathname pathname
 		   :format-arguments (list parent-name)))
-	  (let* ((result (%mkdir parent-name mode)))
-	    (declare (fixnum result))
-	    (if (< result 0)
-	      (signal-file-error result parent-name)
-	      (setq created-p t))))))))
+          (when (and (/= i 1) (not (eql 0 (search "//" parent-name))))
+            (let* ((result (%mkdir parent-name mode)))
+              (declare (fixnum result))
+              (if (< result 0)
+                  (signal-file-error result parent-name)
+                  (setq created-p t)))))))))
 
 
 (defun ensure-directories-exist (pathspec &key verbose (mode #o777))

test

(let* ((host (ipaddr-to-hostname (lookup-hostname "localhost")))
       (tmp (ccl:%get-cstring (#__tempnam (ccl:%null-ptr) (ccl:%null-ptr))))
       (path (concatenate 'string  "\\\\" host "\\"
                           (substitute #\$ #\: tmp))))
  (print path)
  (assert (null (probe-file path)))
  (with-open-file (out path :direction :output)
    (write-line "UCN path" out))
  (assert (probe-file path))
  (with-open-file (in path)
    (assert (string= "UCN path" (read-line in))))
  (delete-file path)
  (assert (null (probe-file path)))
  )