Changeset 15602


Ignore:
Timestamp:
Jan 22, 2013, 8:25:17 PM (6 years ago)
Author:
gb
Message:

Unquote namestrings more carefully.

Fixes ticket:1055 in the trunk.

File:
1 edited

Legend:

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

    r15536 r15602  
    135135                   
    136136(defun namestring-unquote (name)
    137   #+(and windows-target bogus)
    138   (when (and (> (length name) 1)
    139              (eql (schar name 1) #\|))
    140     (setq name (subseq name 0))
    141     (setf (schar name 1) #\:))
    142137  (let ((esc *pathname-escape-character*))
    143     (if (position esc name)
    144       (multiple-value-bind (sstr start end) (get-sstring name)
    145         (let ((result (make-string (%i- end start) :element-type 'base-char))
    146               (dest 0))
    147           (loop
    148             (let ((pos (or (position esc sstr :start start :end end) end)))
    149               (while (%i< start pos)
    150                 (setf (%schar result dest) (%schar sstr start)
    151                       start (%i+ start 1)
    152                       dest (%i+ dest 1)))
    153               (when (eq pos end)
    154                 (return nil))
    155               (setq start (%i+ pos 1))))
    156           (shrink-vector result dest)))
    157       name)))
     138    (multiple-value-bind (sstr start end) (get-sstring name)
     139      (declare (simple-string sstr) (fixnum start end))
     140        (let* ((ncopy 0)
     141               (skipped nil)
     142               (quote-next nil))
     143          (declare (fixnum ncopy))
     144          (do* ((i start (1+ i)))
     145               ((= i end))
     146            (declare (fixnum i))
     147            (let* ((ch (schar sstr i)))
     148              (cond ((or quote-next (not (eq ch esc)))
     149                     (incf ncopy)
     150                     (setq quote-next nil))
     151                    ((eq ch esc) (setq skipped t) (setq quote-next t)))))
     152          (if (not skipped)
     153            name
     154            (let ((result (make-string ncopy))
     155                  (dest 0))
     156              (declare (fixnum dest))
     157              (setq quote-next nil)
     158              (do* ((i start (1+ i)))
     159                   ((= i end) result)
     160                (declare (fixnum i))
     161                (let* ((ch (schar sstr i)))
     162                  (cond ((or quote-next (not (eq ch esc)))
     163                         (setf (schar result dest) ch)
     164                         (incf dest)
     165                         (setq quote-next nil))
     166                        ((eq ch esc) (setq quote-next t)))))))))))
    158167
    159168(defun translated-namestring (path)
Note: See TracChangeset for help on using the changeset viewer.