X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=tests%2Fpathnames.impure.lisp;h=c85df934a49421668302ff5bc46e1e51c846a2e5;hb=a18f0a95bc9a457e4d2d00c702b746f29c2662b1;hp=0824498e7608a58233072fb49a74d25abbd683b3;hpb=e58b011bbe611f10fbc316eea0a3e205c3e40ac7;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 0824498..c85df93 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -98,13 +98,18 @@
 (let ((cond (grab-condition (logical-pathname-translations "unregistered-host"))))
   (assert (typep cond 'type-error)))
 
-;;; examples from CLHS: Section 19.4, Logical Pathname Translations
-;;; (sometimes converted to the Un*x way of things)
+;;; 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.3"))
-               "/library/foo/foo/bar/baz/mum.quux.3"))
+                            "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/*/")
@@ -122,5 +127,12 @@
                             "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"))
+
 ;;; success
 (quit :unix-status 104)