projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.9.2.37:
[sbcl.git]
/
src
/
code
/
filesys.lisp
diff --git
a/src/code/filesys.lisp
b/src/code/filesys.lisp
index
6cd3d31
..
36810cb
100644
(file)
--- a/
src/code/filesys.lisp
+++ b/
src/code/filesys.lisp
@@
-192,8
+192,9
@@
(values absolute (pieces)))))
(defun parse-unix-namestring (namestr start end)
(values absolute (pieces)))))
(defun parse-unix-namestring (namestr start end)
- (declare (type simple-base-string namestr)
+ (declare (type simple-string namestr)
(type index start end))
(type index start end))
+ (setf namestr (coerce namestr 'simple-base-string))
(multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)
(multiple-value-bind (name type version)
(let* ((tail (car (last pieces)))
(multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)
(multiple-value-bind (name type version)
(let* ((tail (car (last pieces)))
@@
-296,7
+297,7
@@
(t
(error "invalid pattern piece: ~S" piece))))))
(apply #'concatenate
(t
(error "invalid pattern piece: ~S" piece))))))
(apply #'concatenate
- 'simple-string
+ 'simple-base-string
(strings))))))
(defun unparse-unix-directory-list (directory)
(strings))))))
(defun unparse-unix-directory-list (directory)
@@
-317,12
+318,12
@@
(error ":BACK cannot be represented in namestrings."))
((member :wild-inferiors)
(pieces "**/"))
(error ":BACK cannot be represented in namestrings."))
((member :wild-inferiors)
(pieces "**/"))
- ((or simple-string pattern)
+ ((or simple-string pattern (member :wild))
(pieces (unparse-unix-piece dir))
(pieces "/"))
(t
(error "invalid directory component: ~S" dir)))))
(pieces (unparse-unix-piece dir))
(pieces "/"))
(t
(error "invalid directory component: ~S" dir)))))
- (apply #'concatenate 'simple-string (pieces))))
+ (apply #'concatenate 'simple-base-string (pieces))))
(defun unparse-unix-directory (pathname)
(declare (type pathname pathname))
(defun unparse-unix-directory (pathname)
(declare (type pathname pathname))
@@
-338,24
+339,30
@@
;; translating logical pathnames to a filesystem without
;; versions (like Unix).
(when name
;; translating logical pathnames to a filesystem without
;; versions (like Unix).
(when name
- (when (and (null type) (position #\. name :start 1))
+ (when (and (null type)
+ (typep name 'string)
+ (> (length name) 0)
+ (position #\. name :start 1))
(error "too many dots in the name: ~S" pathname))
(error "too many dots in the name: ~S" pathname))
+ (when (and (typep name 'string)
+ (string= name ""))
+ (error "name is of length 0: ~S" pathname))
(strings (unparse-unix-piece name)))
(when type-supplied
(unless name
(error "cannot specify the type without a file: ~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 (typep type 'simple-string)
(when (position #\. type)
(error "type component can't have a #\. inside: ~S" pathname)))
(strings ".")
(strings (unparse-unix-piece type))))
(when (position #\. type)
(error "type component can't have a #\. inside: ~S" pathname)))
(strings ".")
(strings (unparse-unix-piece type))))
- (apply #'concatenate 'simple-string (strings))))
+ (apply #'concatenate 'simple-base-string (strings))))
(/show0 "filesys.lisp 406")
(defun unparse-unix-namestring (pathname)
(declare (type pathname pathname))
(/show0 "filesys.lisp 406")
(defun unparse-unix-namestring (pathname)
(declare (type pathname pathname))
- (concatenate 'simple-string
+ (concatenate 'simple-base-string
(unparse-unix-directory pathname)
(unparse-unix-file pathname)))
(unparse-unix-directory pathname)
(unparse-unix-file pathname)))
@@
-369,7
+376,10
@@
(defaults-directory (%pathname-directory defaults))
(prefix-len (length defaults-directory))
(result-directory
(defaults-directory (%pathname-directory defaults))
(prefix-len (length defaults-directory))
(result-directory
- (cond ((and (> prefix-len 1)
+ (cond ((null pathname-directory) '(:relative))
+ ((eq (car pathname-directory) :relative)
+ pathname-directory)
+ ((and (> prefix-len 1)
(>= (length pathname-directory) prefix-len)
(compare-component (subseq pathname-directory
0 prefix-len)
(>= (length pathname-directory) prefix-len)
(compare-component (subseq pathname-directory
0 prefix-len)
@@
-381,8
+391,7
@@
;; We are an absolute pathname, so we can just use it.
pathname-directory)
(t
;; We are an absolute pathname, so we can just use it.
pathname-directory)
(t
- ;; We are a relative directory. So we lose.
- (lose)))))
+ (bug "Bad fallthrough in ~S" 'unparse-unix-enough)))))
(strings (unparse-unix-directory-list result-directory)))
(let* ((pathname-type (%pathname-type pathname))
(type-needed (and pathname-type
(strings (unparse-unix-directory-list result-directory)))
(let* ((pathname-type (%pathname-type pathname))
(type-needed (and pathname-type
@@
-575,9
+584,10
@@
(/noshow0 "computed NAME, TYPE, and VERSION")
(cond ((member name '(nil :unspecific))
(/noshow0 "UNSPECIFIC, more or less")
(/noshow0 "computed NAME, TYPE, and VERSION")
(cond ((member name '(nil :unspecific))
(/noshow0 "UNSPECIFIC, more or less")
- (when (or (not verify-existence)
- (sb!unix:unix-file-kind directory))
- (funcall function directory)))
+ (let ((directory (coerce directory 'base-string)))
+ (when (or (not verify-existence)
+ (sb!unix:unix-file-kind directory))
+ (funcall function directory))))
((or (pattern-p name)
(pattern-p type)
(eq name :wild)
((or (pattern-p name)
(pattern-p type)
(eq name :wild)
@@
-1032,7
+1042,7
@@
:device (pathname-device pathname)
:directory (subseq dir 0 i))))
(unless (probe-file newpath)
:device (pathname-device pathname)
:directory (subseq dir 0 i))))
(unless (probe-file newpath)
- (let ((namestring (namestring newpath)))
+ (let ((namestring (coerce (namestring newpath) 'base-string)))
(when verbose
(format *standard-output*
"~&creating directory: ~A~%"
(when verbose
(format *standard-output*
"~&creating directory: ~A~%"