Fix equality between #p"~" and (user-homedir-pathname) on Win32.

[sbcl.git] / tests / pathnames.impure.lisp

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index f675a8e..0b06d6f 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -325,7 +325,7 @@
 \f
 ;;; 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)))))
 \f
 ;;; BUG 330: "PARSE-NAMESTRING should accept namestrings as the
@@ -398,9 +398,9 @@
 \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.
@@ -412,7 +412,7 @@
     (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)
@@ -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")
@@ -600,7 +600,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