X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpathnames.impure.lisp;h=4361c3dce0e0b91803251dc4882402bd1b110f88;hb=260de2062fca170efdac3e42491d7d866c2d2e56;hp=f675a8e14cbf4524f6a1e941e78533fb8fcb5f1f;hpb=7290a82b4dba4b7f42e98d8475709f4a29e46574;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index f675a8e..4361c3d 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -325,7 +325,7 @@
 
 ;;; 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)
@@ -337,17 +337,17 @@
     (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)))))
 
 ;;; BUG 330: "PARSE-NAMESTRING should accept namestrings as the
@@ -398,9 +398,9 @@
 
 ;;; 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)))))
 
 ;;; we failed to unparse logical pathnames with :NAME :WILD :TYPE NIL.
@@ -412,7 +412,7 @@
     (assert (string= (write-to-string pathname :readably t) "#P\"SYS:**;*\""))))
 
 ;;; 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)
@@ -567,7 +567,7 @@
       (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")
@@ -579,7 +579,9 @@
   ;; 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
@@ -600,7 +602,7 @@
   (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