** VALUES tranformer lost derived type.
changes in sbcl-0.8.8 relative to sbcl-0.8.7:
+ * minor incompatible change: parsing of namestrings on a physical
+ (Unix) host has changed; numbers after the final #\. in a
+ namestring are no longer interpreted as a version field. This is
+ intented to be largely invisible to the user, except that the
+ meaning of the namestring "*.*.*" has changed: it now refers to a
+ pathname with :TYPE :WILD :NAME #<pattern "*.*">. This namestring
+ should usually be replaced by
+ (make-pathname :name :wild :type :wild :version :wild)
+ with the added benefit that this is more likely to be portable.
+ As a consequence of this change, the :IF-EXISTS :NEW-VERSION
+ option to OPEN now signals an error if the file being opened
+ exists; this may have an impact on existing code.
* bug fix: DECODE-UNIVERSAL-TIME now accepts timezone arguments with
second-resolution: integer multiples of 1/3600 between -24 and 24.
(thanks to Vincent Arkesteijn)
or not a character is whitespace.
** MERGE-PATHNAMES handles the case when the pathname does not
specify a name while the default-pathname specifies a version.
+ ** Pathnames now stand a better chance of respecting print/read
+ consistency.
+ ** Attempting to use standardized file system operators with a
+ pathname with invalid :DIRECTORY components signals a
+ FILE-ERROR.
planned incompatible changes in 0.8.x:
* (not done yet, but planned:) When the profiling interface settles
"--sysinit /dev/null"))
initial-function)
"Write an executable called OUTPUT-FILE which can be run from the shell, by 'linking' together code from FASLS. Actually works by concatenating them and prepending a #! header"
- (with-open-file (out output-file :direction :output
+ (with-open-file (out output-file
+ :direction :output
+ :if-exists :supersede
:element-type '(unsigned-byte 8))
(write-sequence (map 'vector #'char-code
(format nil *exec-header* runtime-flags
(write-char #\/ s))
(dolist (piece (cdr directory))
(etypecase piece
- (string (write-string piece s) (write-char #\/ s))))))
+ (string (write-string piece s) (write-char #\/ s))
+ ((member :up) (write-string "../" s))))))
(etypecase name
(null)
(string (write-string name s)))
(sb-posix:chdir *current-directory*)
0)
+(deftest chdir.6
+ (sb-posix:chdir "/../")
+ 0)
+
+(deftest chdir.7
+ (sb-posix:chdir #p"/../")
+ 0)
+
+(deftest chdir.8
+ (sb-posix:chdir (make-pathname :directory '(:absolute :up)))
+ 0)
+
(deftest chdir.error.1
(let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist"))))
(handler-case
(< (- atime unix-now) 10))
t)
+(deftest stat.2
+ (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up))))
+ (mode (sb-posix::stat-mode stat)))
+ ;; it's logically possible for / to be writeable by others... but
+ ;; if it is, either someone is playing with strange security
+ ;; modules or they want to know about it anyway.
+ (logand mode sb-posix::s-iwoth))
+ 0)
+
;;; FIXME: add tests for carrying a stat structure around in the
;;; optional argument to SB-POSIX:STAT
:new-version
:error)))
(case if-exists
- ((:error nil)
+ ((:error nil :new-version)
(setf mask (logior mask sb-unix:o_excl)))
((:rename :rename-and-delete)
(setf mask (logior mask sb-unix:o_creat)))
- ((:new-version :supersede)
+ ((:supersede)
(setf mask (logior mask sb-unix:o_trunc)))))
(t
(setf if-exists nil))) ; :ignore-this-arg
:append :supersede nil)
:if-exists)
(case if-exists
- ((:error nil)
+ ((:new-version :error nil)
(setf mask (logior mask sb!unix:o_excl)))
((:rename :rename-and-delete)
(setf mask (logior mask sb!unix:o_creat)))
- ((:new-version :supersede)
+ ((:supersede)
(setf mask (logior mask sb!unix:o_trunc)))
(:append
(setf mask (logior mask sb!unix:o_append)))))
(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 whether 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)))
- (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)))))
+ :from-end t)))
+ (cond
+ (last-dot
+ (values (maybe-make-pattern namestr start last-dot)
+ (maybe-make-pattern namestr (1+ last-dot) end)
+ :newest))
+ (t
+ (values (maybe-make-pattern namestr start end)
+ nil
+ :newest)))))
(/show0 "filesys.lisp 200")
;; translating logical pathnames to a filesystem without
;; versions (like Unix).
(when name
+ (when (and (null type) (position #\. name :start 1))
+ (error "too many dots in the name: ~S" pathname))
(strings (unparse-unix-piece name)))
(when type-supplied
(unless name
(error "cannot specify the type without a file: ~S" pathname))
+ (when (typep type 'simple-base-string)
+ (when (position #\. type)
+ (error "type component can't have a #\. inside: ~S" pathname)))
(strings ".")
(strings (unparse-unix-piece type))))
(apply #'concatenate 'simple-string (strings))))
;; We are a relative directory. So we lose.
(lose)))))
(strings (unparse-unix-directory-list result-directory)))
- (let* ((pathname-version (%pathname-version pathname))
- (version-needed (and pathname-version
- (not (eq pathname-version :newest))))
- (pathname-type (%pathname-type pathname))
- (type-needed (or version-needed
- (and pathname-type
- (not (eq pathname-type :unspecific)))))
+ (let* ((pathname-type (%pathname-type pathname))
+ (type-needed (and pathname-type
+ (not (eq pathname-type :unspecific))))
(pathname-name (%pathname-name pathname))
(name-needed (or type-needed
(and pathname-name
defaults)))))))
(when name-needed
(unless pathname-name (lose))
+ (when (and (null pathname-type)
+ (position #\. pathname-name :start 1))
+ (error "too many dots in the name: ~S" pathname))
(strings (unparse-unix-piece pathname-name)))
(when type-needed
(when (or (null pathname-type) (eq pathname-type :unspecific))
(lose))
+ (when (typep pathname-type 'simple-base-string)
+ (when (position #\. pathname-type)
+ (error "type component can't have a #\. inside: ~S" pathname)))
(strings ".")
- (strings (unparse-unix-piece pathname-type)))
- (when version-needed
- (typecase pathname-version
- ((member :wild)
- (strings ".*"))
- (integer
- (strings (format nil ".~D" pathname-version)))
- (t
- (lose)))))
+ (strings (unparse-unix-piece pathname-type))))
(apply #'concatenate 'simple-string (strings)))))
\f
;;;; wildcard matching stuff
verify-existence follow-links
nodes function))))
((member :wild-inferiors)
+ ;; now with extra error case handling from CLHS
+ ;; 19.2.2.4.3 -- CSR, 2004-01-24
+ (when (member (cadr tail) '(:up :back))
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of ~S after :WILD-INFERIORS~@:>."
+ :format-arguments (list (cadr tail))))
(%enumerate-directories head (rest tail) pathname
verify-existence follow-links
nodes function)
verify-existence follow-links
nodes function))))))))
((member :up)
- (with-directory-node-removed (head)
+ (when (string= head "/")
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of :UP after :ABSOLUTE.~@:>"))
+ (with-directory-node-removed (head)
(let ((head (concatenate 'base-string head "..")))
(with-directory-node-noted (head)
(%enumerate-directories (concatenate 'base-string head "/")
(rest tail) pathname
verify-existence follow-links
- nodes function)))))))
+ nodes function)))))
+ ((member :back)
+ ;; :WILD-INFERIORS is handled above, so the only case here
+ ;; should be (:ABSOLUTE :BACK)
+ (aver (string= head "/"))
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of :BACK after :ABSOLUTE.~@:>"))))
(%enumerate-files head pathname verify-existence function))))
;;; Call FUNCTION on files.
;;; Convert PATHNAME into a string that can be used with UNIX system
;;; calls, or return NIL if no match is found. Wild-cards are expanded.
-;;; FIXME this should signal file-error if the pathname is wild, whether
-;;; or not it turns out to have only one match. Fix post 0.7.2
(defun unix-namestring (pathname-spec &optional (for-input t))
(let* ((namestring (physicalize-pathname (merge-pathnames pathname-spec)))
(matches nil)) ; an accumulator for actual matches
(upcase-maybe name)
(upcase-maybe type)
version)
- (%make-pathname host device directory name type version))))
+ (progn
+ (aver (eq host *unix-host*))
+ (%make-pathname host device directory name type version)))))
;;; Hash table searching maps a logical pathname's host to its
;;; physical pathname translation.
(%pathname-name pathname2))
(compare-component (%pathname-type pathname1)
(%pathname-type pathname2))
- (compare-component (%pathname-version pathname1)
- (%pathname-version pathname2))))
+ (or (eq (%pathname-host pathname1) *unix-host*)
+ (compare-component (%pathname-version pathname1)
+ (%pathname-version pathname2)))))
;;; Convert PATHNAME-DESIGNATOR (a pathname, or string, or
;;; stream), into a pathname in pathname.
(flet ((add (dir)
(if (and (eq dir :back)
results
- (not (eq (car results) :back)))
+ (not (member (car results)
+ '(:back :wild-inferiors))))
(pop results)
(push dir results))))
(dolist (dir (maybe-diddle-case dir2 diddle-case))
(frob %pathname-directory directory-components-match)
(frob %pathname-name)
(frob %pathname-type)
- (frob %pathname-version))))))
+ (or (eq (%pathname-host wildname) *unix-host*)
+ (frob %pathname-version)))))))
;;; Place the substitutions into the pattern and return the string or pattern
;;; that results. If DIDDLE-CASE is true, we diddle the result case as well,
did not match:~% ~S ~S"
source from))
-;;; Do TRANSLATE-COMPONENT for all components except host and directory.
+;;; Do TRANSLATE-COMPONENT for all components except host, directory
+;;; and version.
(defun translate-component (source from to diddle-case)
(typecase to
(pattern
(with-pathname (from from-wildname)
(with-pathname (to to-wildname)
(let* ((source-host (%pathname-host source))
+ (from-host (%pathname-host from))
(to-host (%pathname-host to))
(diddle-case
(and source-host to-host
(frob %pathname-directory translate-directories)
(frob %pathname-name)
(frob %pathname-type)
- (frob %pathname-version))))))))
+ (if (eq from-host *unix-host*)
+ (if (eq (%pathname-version to) :wild)
+ (%pathname-version from)
+ (%pathname-version to))
+ (frob %pathname-version)))))))))
\f
;;;; logical pathname support. ANSI 92-102 specification.
;;;;
;;; compelling reason for the implementors to choose case
;;; insensitivity and a canonical case.)
(setf (logical-pathname-translations "FOO")
- '(("**;*.*.*" "/full/path/to/foo/**/*.*.*")))
+ '(("**;*.*.*" "/full/path/to/foo/**/*.*")))
(let* ((pn1 (make-pathname :host "FOO" :directory "etc" :name "INETD"
:type "conf"))
(pn2 (make-pathname :host "foo" :directory "ETC" :name "inetd"
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.7.21"
+"0.8.7.22"
projects / sbcl.git / commitdiff