diff --git a/code/filesys.lisp b/code/filesys.lisp index e28f4e069d2312e0b2be7052bcf393400083466b..33834f0708d6340757dd14004c77085f83f56483 100644 --- a/code/filesys.lisp +++ b/code/filesys.lisp @@ -6,7 +6,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.58 2000/08/24 14:22:56 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.59 2001/02/22 19:35:01 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -38,9 +38,9 @@ ;;; search-list := [^:/]*: ;;; file := [^/]* ;;; type := "." [^/.]* -;;; version := "." ([0-9]+ | "*") +;;; version := ".~" ([0-9]+ | "*") "~" ;;; -;;; Note: this grammer is ambiguous. The string foo.bar.5 can be parsed +;;; Note: this grammer is ambiguous. The string foo.bar.~5~ can be parsed ;;; as either just the file specified or as specifying the file, type, and ;;; version. Therefore, we use the following rules when confronted with ;;; an ambiguous file.type.version string: @@ -170,44 +170,41 @@ (t (make-pattern (pattern))))))) +;;; extract-name-type-and-version -- Internal. +;;; (defun extract-name-type-and-version (namestr start end) (declare (type simple-base-string namestr) (type index start end)) - (let* ((last-dot (position #\. namestr :start (1+ start) :end end - :from-end t)) - (second-to-last-dot (and last-dot - (position #\. namestr :start (1+ start) - :end last-dot :from-end t))) - (version :newest)) - ;; If there is a second-to-last dot, check to see if there is a valid - ;; version after the last dot. - (when second-to-last-dot - (cond ((and (= (+ last-dot 2) end) - (char= (schar namestr (1+ last-dot)) #\*)) - (setf version :wild)) - ((and (< (1+ last-dot) end) - (do ((index (1+ last-dot) (1+ index))) - ((= index end) t) - (unless (char<= #\0 (schar namestr index) #\9) - (return nil)))) - (setf version - (parse-integer namestr :start (1+ last-dot) :end end))) + (multiple-value-bind (version vstart) + (cond ((or (< (- end start) 5) + (char/= (schar namestr (1- end)) #\~)) + (values :newest end)) + ((and (char= (schar namestr (- end 2)) #\*) + (char= (schar namestr (- end 3)) #\~) + (char= (schar namestr (- end 4)) #\.)) + (values :wild (- end 4))) (t - (setf second-to-last-dot nil)))) - (cond (second-to-last-dot - (values (maybe-make-pattern namestr start second-to-last-dot) - (maybe-make-pattern namestr - (1+ second-to-last-dot) - last-dot) - version)) - (last-dot - (values (maybe-make-pattern namestr start last-dot) - (maybe-make-pattern namestr (1+ last-dot) end) - version)) - (t - (values (maybe-make-pattern namestr start end) - nil - version))))) + (do ((i (- end 2) (1- i))) + ((< i (+ start 2)) (values :newest nil)) + (let ((char (schar namestr i))) + (when (eql char #\~) + (return (and (char= (schar namestr (1- i)) #\.) + (values (parse-integer namestr + :start (1+ i) + :end (1- end)) + (1- i))))) + (unless (char<= #\0 char #\9) + (return nil)))))) + (let ((last-dot (position #\. namestr :start (1+ start) :end vstart + :from-end t))) + (cond (last-dot + (values (maybe-make-pattern namestr start last-dot) + (maybe-make-pattern namestr (1+ last-dot) vstart) + version)) + (t + (values (maybe-make-pattern namestr start vstart) + nil + version)))))) ;;; Take a string and return a list of cons cells that mark the char ;;; separated subseq. The first value t if absolute directories location. @@ -407,11 +404,9 @@ (strings ".") (strings (unparse-unix-piece type))) (when version-supplied - (unless type-supplied - (error "Cannot specify the version without a type: ~S" pathname)) (strings (if (eq version :wild) - ".*" - (format nil ".~D" version))))) + ".~~*~~" + (format nil ".~~~D~~" version))))) (and (strings) (apply #'concatenate 'simple-string (strings))))) (defun unparse-unix-namestring (pathname) @@ -469,9 +464,9 @@ (when version-needed (typecase pathname-version ((member :wild) - (strings ".*")) + (strings ".~~*~~")) (integer - (strings (format nil ".~D" pathname-version))) + (strings (format nil ".~~~D~~" pathname-version))) (t (lose))))) (apply #'concatenate 'simple-string (strings))))) @@ -514,9 +509,6 @@ (when (pathname-type pathname) (unless (pathname-name pathname) (error "Cannot supply a type without a name:~% ~S" pathname))) - (when (and (integerp (pathname-version pathname)) - (member (pathname-type pathname) '(nil :unspecific))) - (error "Cannot supply a version without a type:~% ~S" pathname)) (let ((directory (pathname-directory pathname))) (if directory (ecase (car directory)