;;; CL:PARSE-ERROR (or more specifically, of type
;;; SB-KERNEL:NAMESTRING-PARSE-ERROR).
(assert
- (typep (grab-condition (translate-logical-pathname "demo0::bla;file.lisp"))
+ (typep (grab-condition (logical-pathname "demo0::bla;file.lisp"))
'parse-error))
;;; some things SBCL-0.6.9 used not to parse correctly:
;;; FIXME: currently SBCL throws NAMESTRING-PARSE-ERROR: should this be
;;; a TYPE-ERROR?
-;;; FIXME: These fail in sbcl-0.pre7.15 because of some problem with
-;;; interpreted UNLESS, so that e.g.
-;;; (ignore-errors (make-pathname :host "FOO" :directory "!bla" :name "bar"))
-;;; => NIL, #<SIMPLE-TYPE-ERROR {500C945D}>
-;;; (not (ignore-errors (make-pathname :host "FOO"
-;;; :directory "!bla" :name "bar")))
-;;; =>T
-;;; (unless (not (ignore-errors (make-pathname :host "FOO"
-;;; :directory "!bla"
-;;; :name "bar")))
-;;; "foo")
-;;; => "foo"
-;;; (unless t "foo")
-;;; => NIL
-#|
-;; error: directory-component not valid
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
-
-;; error: name-component not valid
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "bla" :name "!bar"))))
-
-;; error: type-component not valid.
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "bla" :name "bar"
- :type "&baz"))))
+(locally
+ ;; MAKE-PATHNAME is UNSAFELY-FLUSHABLE
+ (declare (optimize safety))
+
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
+
+ ;; error: name-component not valid
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "bla" :name "!bar"))))
+
+ ;; error: type-component not valid.
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "bla" :name "bar"
+ :type "&baz")))))
;;; We may need to parse the host as a LOGICAL-NAMESTRING HOST. The
;;; HOST in PARSE-NAMESTRING can be either a string or :UNSPECIFIC
;;; from host mismatches).
(assert (equal (namestring (parse-namestring "" "FOO")) "FOO:"))
(assert (equal (namestring (parse-namestring "" :unspecific)) ""))
-|#
;;; The third would work if the call were (and it should continue to
;;; work ...)
;;; turning one logical pathname into another:
(setf (logical-pathname-translations "foo")
- '(("tohome;*.*.*" "home:*.*.*")))
-(assert (equal (namestring (translate-logical-pathname "foo:tohome;x.y"))
- "home:x.y"))
+ '(("todemo;*.*.*" "demo0:*.*.*")))
+(assert (equal (namestring (translate-logical-pathname "foo:todemo;x.y"))
+ (namestring (translate-logical-pathname "demo0:x.y"))))
;;; ANSI, in its wisdom, specifies that it's an error (specifically a
;;; TYPE-ERROR) to query the system about the translations of a string
(let ((cond (grab-condition (logical-pathname-translations "unregistered-host"))))
(assert (typep cond 'type-error)))
+(assert (not (string-equal (host-namestring (parse-namestring "OTHER-HOST:ILLEGAL/LPN")) "OTHER-HOST")))
+(assert (string-equal (pathname-name (parse-namestring "OTHER-HOST:ILLEGAL/LPN")) "LPN"))
+
;;; FIXME: A comment on this section up to sbcl-0.6.11.30 or so said
;;; examples from CLHS: Section 19.4, LOGICAL-PATHNAME-TRANSLATIONS
;;; (sometimes converted to the Un*x way of things)
;;;; or failure in these tests doesn't tell you anything about
;;;; ANSI-compliance unless your PARSE-NAMESTRING works like ours.
-(setf (logical-pathname-translations "scratch")
- '(("**;*.*.*" "/usr/local/doc/**/*")))
+;;; Needs to be done at compile time, so that the #p"" read-macro
+;;; correctly parses things as logical pathnames. This is not a
+;;; problem as was, as this is an impure file and so gets loaded in,
+;;; but just for future proofing...
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (logical-pathname-translations "scratch")
+ '(("**;*.*.*" "/usr/local/doc/**/*"))))
(loop for (expected-result . params) in
`(;; trivial merge
;; as a name)
(#p"/dir/name.supplied-type"
,(make-pathname :type "supplied-type")
- #p"/dir/name.type")
+ #p"/dir/name.type")
;; If (pathname-directory pathname) is a list whose car is
;; :relative, and (pathname-directory default-pathname) is a
;; list, then the merged directory is [...]
(#P"/aaa/bbb/ccc/blah/eee"
;; "../" in a namestring is parsed as :up not :back, so make-pathname
,(make-pathname :directory '(:relative :back "blah"))
- #p"/aaa/bbb/ccc/ddd/eee")
+ #p"/aaa/bbb/ccc/ddd/eee")
;; If (pathname-directory default-pathname) is not a list or
;; (pathname-directory pathname) is not a list whose car is
;; :relative, the merged directory is (or (pathname-directory
;; pathname) (pathname-directory default-pathname))
(#P"/absolute/path/name.type"
#p"/absolute/path/name"
- #p"/dir/default-name.type")
+ #p"/dir/default-name.type")
;; === logical pathnames ===
;; recognizes a logical pathname namestring when
;; default-pathname is a logical pathname
- ;; FIXME: 0.6.12.23 fails this one.
+ ;; FIXME: 0.6.12.23 fails this one.
+ ;;
+ ;; And, as it happens, it's right to fail it. Because
+ ;; #p"name1" is read in with the ambient *d-p-d* value, which
+ ;; has a physical (Unix) host; therefore, the host of the
+ ;; default-pathname argument to merge-pathnames is
+ ;; irrelevant. The result is (correctly) different if
+ ;; '#p"name1"' is replaced by "name1", below, though it's
+ ;; still not what one might expect... -- CSR, 2002-05-09
#+nil (#P"scratch:foo;name1" #p"name1" #p"scratch:foo;")
;; or when the namestring begins with the name of a defined
;; logical host followed by a colon [I assume that refers to pathname
do (assert (string= (namestring (apply #'merge-pathnames params))
(namestring expected-result))))
\f
+;;; host-namestring testing
+(assert (string=
+ (namestring (parse-namestring "/foo" (host-namestring #p"/bar")))
+ "/foo"))
+(assert (string=
+ (namestring (parse-namestring "FOO" (host-namestring #p"SCRATCH:BAR")))
+ "SCRATCH:FOO"))
+(assert (raises-error?
+ (setf (logical-pathname-translations "")
+ (list '("**;*.*.*" "/**/*.*")))))
+\f
+;;; Bug 200: translate-logical-pathname is according to the spec supposed
+;;; not to give errors if asked to translate a namestring for a valid
+;;; physical pathname. Failed in 0.7.7.28 and before
+(assert (string= (namestring (translate-logical-pathname "/")) "/"))
+
+\f
+;;; Not strictly pathname logic testing, but until sbcl-0.7.6.19 we
+;;; had difficulty with non-FILE-STREAM stream arguments to pathname
+;;; functions (they would cause memory protection errors). Make sure
+;;; that those errors are gone:
+(assert (raises-error? (pathname (make-string-input-stream "FOO"))
+ type-error))
+(assert (raises-error? (merge-pathnames (make-string-output-stream))
+ type-error))
+\f
;;;; success
(quit :unix-status 104)
projects / sbcl.git / blobdiff