;;; some things SBCL-0.6.9 used not to parse correctly:
;;;
;;; SBCL used to throw an error saying there's no translation.
-(with-test (:name (:logical-pathname 1))
+(with-test (:name (:logical-pathname 1) :fails-on :win32)
(assert (equal (namestring (translate-logical-pathname "demo0:file.lisp"))
"/tmp/file.lisp")))
"/tmp/**/foo.lisp"))))
;;; That should be correct:
-(with-test (:name (:logical-pathname 4))
+(with-test (:name (:logical-pathname 4) :fails-on :win32)
(assert (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
"/tmp/foo.lisp")))
;;; Check for absolute/relative path confusion:
-(with-test (:name (:logical-pathname 5))
+(with-test (:name (:logical-pathname 5) :fails-on :win32)
(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.
-(with-test (:name (:logical-pathname 14))
+(with-test (:name (:logical-pathname 14) :fails-on :win32)
(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.
-(with-test (:name (:logical-pathname 15))
+(with-test (:name (:logical-pathname 15) :fails-on :win32)
(assert (equal (namestring (translate-logical-pathname
"test0:foo;bar;baz;mum.quux.3"))
"/library/foo/foo/bar/baz/mum.quux")))
\f
;;; ensure read/print consistency (or print-not-readable-error) on
;;; pathnames:
-(with-test (:name :print/read-consistency)
+(with-test (:name :print/read-consistency :fails-on :win32)
(let ((pathnames (list
(make-pathname :name "foo" :type "txt" :version :newest)
(make-pathname :name "foo" :type "txt" :version 1)
\f
;;; we got (truename "/") wrong for about 6 months. Check that it's
;;; still right.
-(with-test (:name :root-truename)
+(with-test (:name :root-truename :fails-on :win32)
(let ((pathname (truename "/")))
(assert (equalp pathname #p"/"))
(assert (equal (pathname-directory pathname) '(:absolute)))))
(assert (string= (write-to-string pathname :readably t) "#P\"SYS:**;*\""))))
\f
;;; reported by James Y Knight on sbcl-devel 2006-05-17
-(with-test (:name :merge-back)
+(with-test (:name :merge-back :fails-on :win32)
(let ((p1 (make-pathname :directory '(:relative "bar")))
(p2 (make-pathname :directory '(:relative :back "foo"))))
(assert (equal (merge-pathnames p1 p2)
;;; Reported by Willem Broekema: Reading #p"\\\\" caused an error due
;;; to insufficient sanity in input testing in EXTRACT-DEVICE (in
;;; src;code;win32-pathname).
-#+win32
-(with-test (:name :bug-489698)
+(with-test (:name :bug-489698 :skipped-on '(not :win32))
(assert (equal (make-pathname :directory '(:absolute))
(read-from-string "#p\"\\\\\\\\\""))))
-(with-test (:name :load-logical-pathname-translations)
+(with-test (:name :load-logical-pathname-translations :fails-on :win32)
(let* ((cwd (truename "."))
(foo (merge-pathnames "llpnt-foo.translations" cwd))
(bar (merge-pathnames "llpnt-bar.translations" cwd))
(ignore-errors (delete-file bar))
(setf (logical-pathname-translations "SYS") translations))))
+(with-test (:name :tilde-expansion :fails-on :win32)
+ (assert (equal '(:absolute :home "foo") (pathname-directory "~/foo/bar.txt")))
+ (assert (equal '(:absolute (:home "jdoe") "quux") (pathname-directory "~jdoe/quux/")))
+ (assert (equal "~/foo/x" (namestring (make-pathname :directory '(:absolute :home "foo")
+ :name "x"))))
+ (assert (equal (native-namestring (merge-pathnames "a/b.c" (user-homedir-pathname)))
+ (native-namestring #p"~/a/b.c")))
+ ;; Not a directory.
+ (assert (equal (native-namestring #p"~foo") "~foo"))
+ ;; Not at the start of the first directory
+ (assert (equal (native-namestring #p"foo/~/bar")
+ #-win32 "foo/~/bar"
+ #+win32 "foo\\~\\bar")))
+
+;;; lp#673625
+(with-test (:name :pathname-escape-first-directory-component
+ :fails-on :win32)
+ ;; ~ / :HOME
+ (assert (equal (pathname-directory #p"\\~/foo/") '(:relative "~" "foo")))
+ (assert (equal (native-namestring #p"\\~/foo/") "~/foo/"))
+ (assert (equal (namestring (make-pathname :directory '(:absolute "~zot")))
+ "\\~zot/"))
+ ;; * / :WILD
+ (assert (equal (pathname-directory #p"\\*/") '(:relative "*"))))
+
+(with-test (:name :ensure-directories-exist-with-odd-d-p-d
+ :fails-on :win32)
+ (let ((*default-pathname-defaults* #p"/tmp/foo"))
+ (ensure-directories-exist "/")))
+
;;;; success