+ '(("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
+;;; which doesn't have any translations. It's not clear why we don't
+;;; just return NIL in that case, but they make the rules..
+(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)
+;;; but when I looked it up I didn't see the connection. Presumably
+;;; there's some code in this section which should be attributed
+;;; to something in the ANSI spec, but I don't know what code it is
+;;; or what section of the specification has the related code.
+(setf (logical-pathname-translations "test0")
+ '(("**;*.*.*" "/library/foo/**/")))
+(assert (equal (namestring (translate-logical-pathname
+ "test0:foo;bar;baz;mum.quux"))
+ "/library/foo/foo/bar/baz/mum.quux"))
+(setf (logical-pathname-translations "prog")
+ '(("RELEASED;*.*.*" "MY-UNIX:/sys/bin/my-prog/")
+ ("RELEASED;*;*.*.*" "MY-UNIX:/sys/bin/my-prog/*/")
+ ("EXPERIMENTAL;*.*.*" "MY-UNIX:/usr/Joe/development/prog/")
+ ("EXPERIMENTAL;*;*.*.*" "MY-UNIX:/usr/Joe/development/prog/*/")))
+(setf (logical-pathname-translations "prog")
+ '(("CODE;*.*.*" "/lib/prog/")))
+(assert (equal (namestring (translate-logical-pathname
+ "prog:code;documentation.lisp"))
+ "/lib/prog/documentation.lisp"))
+(setf (logical-pathname-translations "prog")
+ '(("CODE;DOCUMENTATION.*.*" "/lib/prog/docum.*")
+ ("CODE;*.*.*" "/lib/prog/")))
+(assert (equal (namestring (translate-logical-pathname
+ "prog:code;documentation.lisp"))
+ "/lib/prog/docum.lisp"))
+
+;;; ANSI section 19.3.1.1.5 specifies that translation to a filesystem
+;;; which doesn't have versions should ignore the version slot. CMU CL
+;;; didn't ignore this as it should, but we do.
+(assert (equal (namestring (translate-logical-pathname
+ "test0:foo;bar;baz;mum.quux.3"))
+ "/library/foo/foo/bar/baz/mum.quux"))
+\f
+;;;; MERGE-PATHNAME tests
+;;;;
+;;;; There are some things we don't bother testing, just because they're
+;;;; not meaningful on the underlying filesystem anyway.
+;;;;
+;;;; Mostly that means that we don't do devices, we don't do versions
+;;;; except minimally in LPNs (they get lost in the translation to
+;;;; physical hosts, so it's not much of an issue), and we don't do
+;;;; hosts except for LPN hosts
+;;;;
+;;;; Although these tests could conceivably be useful in principle for
+;;;; 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.
+
+;;; 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/**/*"))))