Changeset 11859


Ignore:
Timestamp:
Mar 29, 2009, 5:41:14 PM (10 years ago)
Author:
gb
Message:

Functions that parse namestrings have called GET-SSTRING on their
string arguments so that they're sure that they're operating on a
bounded SIMPLE-STRING. Those parsing functions (hopefully all of
them) now call GET-PATHNAME-SSTRING instead. On non-Windows platforms,
this just calls GET-SSTRING and returns its results; on Windows, it
checks to see if the bounded simple-string contains backslashes and
if so, it returns a copy with the backslashes replaced with forward-slashes.

This is one way to allow pathname functions to handle Windows pathnames
that use #
as a directory separator. (The other way would be to
change a lot of ancient namestring-parsing code to handle either #
or #\/ as a directory separator, and this approach is certainly simpler.)
The extra consing should only happen if user code does something like:

(let* ((home-string (getenv "HOME")))

(if home-string

(pathname-name home-string)))

System code that deals with namestrings returned by the OS can generally
destructively change any backslashes in that namestring to forward slashes
before passing the string to pathname-parsing functions.

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-files.lisp

    r11756 r11859  
    499499  (when path (pathname path)))
    500500
     501(defun get-pathname-sstring (string &optional (start 0) (end (length string)))
     502  #-windows-target
     503  (get-sstring string start end)
     504  #+windows-target
     505  (multiple-value-bind (sstr start end)
     506      (get-sstring string start end)
     507    (declare (fixnum start end)
     508             (simple-string sstr))
     509    (if (do* ((i start (1+ i)))
     510             ((= i end))
     511          (declare (fixnum i))
     512          (when (eql (schar sstr i) #\\)
     513            (return t)))
     514      (let* ((len (- end start))
     515             (new (make-string len)))
     516        (declare (fixnum len) (simple-string new))
     517        (dotimes (i len)
     518          (let* ((ch (schar sstr start)))
     519            (if (eql ch #\\)
     520              (setf (schar new i) #\/)
     521              (setf (schar new i) ch)))
     522          (incf start))
     523        (values new 0 len))
     524      (values sstr start end))))
     525             
    501526(defun string-to-pathname (string &optional (start 0) (end (length string))
    502527                                            (reference-host nil)
    503528                                            (defaults *default-pathname-defaults*))
    504529  (require-type reference-host '(or null string))
    505   (multiple-value-bind (sstr start end) (get-sstring string start end)
     530  (multiple-value-bind (sstr start end) (get-pathname-sstring string start end)
    506531    #-windows-target
    507532    (if (and (> end start)
     
    745770           (logical-pathname (%logical-pathname-host thing))
    746771           (pathname :unspecific)
    747            (string (multiple-value-bind (sstr start end) (get-sstring thing)
     772           (string (multiple-value-bind (sstr start end) (get-pathname-sstring thing)
    748773                     (pathname-host-sstr sstr start end)))
    749774           (t (report-bad-arg thing pathname-arg-type)))))
     
    795820                  (pathname (%pathname-directory path))
    796821                  (string
    797                    (multiple-value-bind (sstr start end) (get-sstring path)
    798                      #+no
    799                      (if (and (> end start)
    800                               (eql (schar sstr start) #\~))
    801                        (setq sstr (tilde-expand (subseq sstr start end))
    802                              start 0
    803                              end (length sstr)))
     822                   (multiple-value-bind (sstr start end) (get-pathname-sstring path)
    804823                     (multiple-value-bind (host pos2) (pathname-host-sstr sstr start end)
    805824                       (unless (eq host :unspecific) (setq logical-p t))
     
    881900    (pathname (%physical-pathname-version path))
    882901    (string
    883      (multiple-value-bind (sstr start end) (get-sstring path)
     902     (multiple-value-bind (sstr start end) (get-pathname-sstring path)
    884903       (multiple-value-bind (newstart host) (pathname-directory-end sstr start end)
    885904         (if (eq host :unspecific)
     
    916935                 (pathname (%pathname-name path))
    917936                 (string
    918                   (multiple-value-bind (sstr start end) (get-sstring path)
     937                  (multiple-value-bind (sstr start end) (get-pathname-sstring path)
    919938                    (multiple-value-bind (newstart host) (pathname-directory-end sstr start end)
    920939                      (setq start newstart)
     
    952971                 (pathname (%pathname-type path))
    953972                 (string
    954                   (multiple-value-bind (sstr start end) (get-sstring path)
     973                  (multiple-value-bind (sstr start end) (get-pathname-sstring path)
    955974                    (multiple-value-bind (newstart host) (pathname-directory-end sstr start end)
    956975                      (setq start newstart)
  • trunk/source/level-1/l1-pathnames.lisp

    r11639 r11859  
    361361
    362362(defun logical-pathname-namestring-p (string)
    363   (multiple-value-bind (sstr start end) (get-sstring string)
     363  (multiple-value-bind (sstr start end) (get-pathname-sstring string)
    364364    (let ((host (pathname-host-sstr sstr start end t)))
    365365      (and host (not (eq host :unspecific))))))
Note: See TracChangeset for help on using the changeset viewer.