;;; some things SBCL-0.6.9 used not to parse correctly:
;;;
;;; SBCL used to throw an error saying there's no translation.
;;; some things SBCL-0.6.9 used not to parse correctly:
;;;
;;; SBCL used to throw an error saying there's no translation.
(assert (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
"/tmp/foo.lisp")))
;;; Check for absolute/relative path confusion:
(assert (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
"/tmp/foo.lisp")))
;;; Check for absolute/relative path confusion:
(assert (not (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
"tmp/rel/foo.lisp")))
(assert (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
(assert (not (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
"tmp/rel/foo.lisp")))
(assert (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
;;; 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.
;;; 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
(setf (logical-pathname-translations "test0")
'(("**;*.*.*" "/library/foo/**/")))
(assert (equal (namestring (translate-logical-pathname
;;; 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.
;;; 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")))
(assert (equal (namestring (translate-logical-pathname
"test0:foo;bar;baz;mum.quux.3"))
"/library/foo/foo/bar/baz/mum.quux")))
(let* ((cwd (truename "."))
(foo (merge-pathnames "llpnt-foo.translations" cwd))
(bar (merge-pathnames "llpnt-bar.translations" cwd))
(let* ((cwd (truename "."))
(foo (merge-pathnames "llpnt-foo.translations" cwd))
(bar (merge-pathnames "llpnt-bar.translations" cwd))