(assert (raises-error? (merge-pathnames (make-string-output-stream))
type-error)))
\f
-;;; ensure read/print consistency (or print-not-readable-error) on
+;;; ensure print-read consistency (or print-not-readable-error) on
;;; pathnames:
-(with-test (:name :print/read-consistency :fails-on :win32)
+(with-test (:name :print/read-consistency)
(let ((pathnames (list
(make-pathname :name "foo" :type "txt" :version :newest)
(make-pathname :name "foo" :type "txt" :version 1)
(dolist (p pathnames)
(print p)
(handler-case
- (let* ((*print-readably* t)
- (new (read-from-string (format nil "~S" p))))
- (unless (equal new p)
- (let ((*print-readably* nil))
- (error "oops: host:~S device:~S dir:~S version:~S~% ->~%~
+ (let* ((*print-readably* t)
+ (new (read-from-string (format nil "~S" p))))
+ (unless (equal new p)
+ (let ((*print-readably* nil))
+ (error "oops: host:~S device:~S dir:~S version:~S~% ->~%~
host:~S device:~S dir:~S version:~S"
- (pathname-host p) (pathname-device p)
- (pathname-directory p) (pathname-version p)
- (pathname-host new) (pathname-device new)
- (pathname-directory new) (pathname-version new)))))
- (print-not-readable ()
+ (pathname-host p) (pathname-device p)
+ (pathname-directory p) (pathname-version p)
+ (pathname-host new) (pathname-device new)
+ (pathname-directory new) (pathname-version new)))))
+ (print-not-readable ()
nil)))))
\f
;;; BUG 330: "PARSE-NAMESTRING should accept namestrings as the
\f
;;; we got (truename "/") wrong for about 6 months. Check that it's
;;; still right.
-(with-test (:name :root-truename :fails-on :win32)
+(with-test (:name :root-truename)
(let ((pathname (truename "/")))
- (assert (equalp pathname #p"/"))
+ (assert (equalp pathname (merge-pathnames #p"/")))
(assert (equal (pathname-directory pathname) '(:absolute)))))
\f
;;; we failed to unparse logical pathnames with :NAME :WILD :TYPE NIL.
(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 :fails-on :win32)
+(with-test (:name :merge-back)
(let ((p1 (make-pathname :directory '(:relative "bar")))
(p2 (make-pathname :directory '(:relative :back "foo"))))
(assert (equal (merge-pathnames p1 p2)
(ignore-errors (delete-file bar))
(setf (logical-pathname-translations "SYS") translations))))
-(with-test (:name :tilde-expansion :fails-on :win32)
+(with-test (:name :tilde-expansion)
(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")
;; Not at the start of the first directory
(assert (equal (native-namestring #p"foo/~/bar")
#-win32 "foo/~/bar"
- #+win32 "foo\\~\\bar")))
+ #+win32 "foo\\~\\bar"))
+ (equal (native-namestring (merge-pathnames "~/"))
+ (native-namestring (user-homedir-pathname))))
;;; lp#673625
(with-test (:name :pathname-escape-first-directory-component
(let* ((x '("hint--if-you-are-having-trouble-deleting-this-test-directory"
"use-the-7zip-file-manager"))
(base (truename
- (directory-namestring (or *load-pathname* *compile-pathname*))))
+ (directory-namestring (or *load-pathname* *compile-file-pathname*))))
(shallow (make-pathname :directory `(:relative ,(car x))))
(shallow (merge-pathnames shallow base))
(deep (make-pathname