X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpathnames.impure.lisp;h=00da4c03c891f52bdcf8aa5ab96507045153f7cd;hb=3bbbfec26f90bc005c2ff5c8de0ceb0f95f1a52b;hp=08dfa2800ea2603d7a8a1a842134f75918930e19;hpb=d171bd26f76aaa12d600542337b4186296c2c03d;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 08dfa28..00da4c0 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -79,7 +79,6 @@
 ;;; FIXME: currently SBCL throws NAMESTRING-PARSE-ERROR: should this be
 ;;; a TYPE-ERROR?
 
-;; error: directory-component not valid
 (assert (not (ignore-errors
                (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
 
@@ -112,9 +111,9 @@
 
 ;;; 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
@@ -123,6 +122,9 @@
 (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)
@@ -173,10 +175,15 @@
 ;;;; other implementations, they depend quite heavily on the rules for
 ;;;; namestring parsing, which are implementation-specific. So, success
 ;;;; or failure in these tests doesn't tell you anything about
-;;;; ansi-compliance unless your PARSE-NAMESTRING works like ours.
+;;;; 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
@@ -192,7 +199,7 @@
         ;; 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 [...]
@@ -203,18 +210,26 @@
         (#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.20 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
@@ -244,10 +259,21 @@
         (#p"SCRATCH:ABSOLUTE;PATH;NAME.TYPE"
          #p"scratch:absolute;path;name" #p"/dir/default-name.type")
 
-        ;; TODO: test version handling in LPNs
+        ;; FIXME: test version handling in LPNs
         )
       do (assert (string= (namestring (apply #'merge-pathnames params))
                           (namestring expected-result))))
 
+;;; 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 '("**;*.*.*" "/**/*.*")))))
+
 ;;;; success
 (quit :unix-status 104)