X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=f6ac941d9714948691cfd8d3b77c3a4ea165f42c;hb=6d36f2d6954cb79e3c88fef33fe0c3ad63deaea8;hp=cff87b5f80d6abc51ea80602895f86c687530cea;hpb=6584a2c88efaa6931083721adae2f9f10e0fefd5;p=sbcl.git

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index cff87b5..f6ac941 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -32,8 +32,7 @@
   ;; We know a little bit about the structure of this result;
   ;; let's test to make sure that this test file is in it.
   (assert (find-if (lambda (pathname)
-                     (search #-win32 "tests/filesys.pure.lisp"
-                             #+win32 "tests\\filesys.pure.lisp"
+                     (search "tests/filesys.pure.lisp"
                              (namestring pathname)))
                    dir)))
 ;;; In sbcl-0.9.7 DIRECTORY failed on pathnames with character-set
@@ -92,10 +91,7 @@
   (assert (equal "C:\\FOO" (native-namestring "C:\\FOO")))
   (assert (equal "C:\\FOO" (native-namestring "C:/FOO")))
   (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR")))
-  ;; FIXME: Other platforms don't do this: either fix Windows
-  ;; so that it works even with the same logic others use, or
-  ;; make this official. (Currently just a kludge.)
-  (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR\\"))))
+  (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR\\" :as-file t))))
 
 ;;; Test for NATIVE-PATHNAME / NATIVE-NAMESTRING stuff
 ;;;
@@ -104,40 +100,85 @@
 ;;; original namestring.
 (with-test (:name :random-native-namestrings)
   (let ((safe-chars
-        (coerce
-         (cons #\Newline
-               (loop for x from 32 to 127 collect (code-char x)))
-         'simple-base-string))
-       (tricky-sequences #("/../" "../" "/.." "." "/." "./" "/./"
-                           "[]" "*" "**" "/**" "**/" "/**/" "?"
-                           "\\*" "\\[]" "\\?" "\\*\\*" "*\\*")))
-   (loop repeat 1000
-      for length = (random 32)
-      for native-namestring = (coerce
-                               (loop repeat length
-                                  collect
-                                  (char safe-chars
-                                        (random (length safe-chars))))
-                               'simple-base-string)
-      for pathname = (native-pathname native-namestring)
-      for nnn = (native-namestring pathname)
-      do (assert (string= nnn native-namestring)))
-   (loop repeat 1000
-      for native-namestring = (with-output-to-string (s)
-                                (loop
-                                   (let ((r (random 1.0)))
-                                     (cond
-                                       ((< r 1/20) (return))
-                                       ((< r 1/2)
-                                        (write-char
+         (coerce
+          (cons #\Newline
+                (loop for x from 32 to 127 collect (code-char x)))
+          'simple-base-string))
+        (tricky-sequences #("/../" "../" "/.." "." "/." "./" "/./"
+                            "[]" "*" "**" "/**" "**/" "/**/" "?"
+                            "\\*" "\\[]" "\\?" "\\*\\*" "*\\*")))
+    (loop repeat 1000
+          for length = (random 32)
+          for native-namestring = (coerce
+                                   (loop repeat length
+                                         collect
                                          (char safe-chars
-                                               (random (length safe-chars)))
-                                         s))
-                                       (t (write-string
-                                           (aref tricky-sequences
-                                                 (random
-                                                  (length tricky-sequences)))
-                                           s))))))
-      for pathname = (native-pathname native-namestring)
-      for tricky-nnn = (native-namestring pathname)
-      do (assert (string= tricky-nnn native-namestring)))))
+                                               (random (length safe-chars))))
+                                   'simple-base-string)
+          for pathname = (native-pathname native-namestring)
+          for nnn = (native-namestring pathname)
+          do #+win32
+             ;; We canonicalize to \ as the directory separator
+             ;; on windows -- though both \ and / are legal.
+             (setf native-namestring (substitute #\\ #\/ native-namestring))
+             (unless (string= nnn native-namestring)
+               (error "1: wanted ~S, got ~S" native-namestring nnn)))
+    (loop repeat 1000
+          for native-namestring = (with-output-to-string (s)
+                                    (write-string "mu" s)
+                                    (loop
+                                      (let ((r (random 1.0)))
+                                        (cond
+                                          ((< r 1/20) (return))
+                                          ((< r 1/2)
+                                           (write-char
+                                            (char safe-chars
+                                                  (random (length safe-chars)))
+                                            s))
+                                          (t (write-string
+                                              (aref tricky-sequences
+                                                    (random
+                                                     (length tricky-sequences)))
+                                              s))))))
+          for pathname = (native-pathname native-namestring)
+          for tricky-nnn = (native-namestring pathname)
+          do #+win32
+             ;; We canonicalize to \ as the directory separator
+             ;; on windows -- though both \ and / are legal.
+             (setf native-namestring (substitute #\\ #\/ native-namestring))
+             (unless (string= tricky-nnn native-namestring)
+               (error "2: wanted ~S, got ~S" native-namestring tricky-nnn)))))
+
+;;; USER-HOMEDIR-PATHNAME and the extension SBCL-HOMEDIR-PATHNAME both
+;;; used to call PARSE-NATIVE-NAMESTRING without supplying a HOST
+;;; argument, and so would lose when *DEFAULT-PATHNAME-DEFAULTS* was a
+;;; logical pathname.
+(with-test (:name :user-homedir-pathname-robustness)
+  (let ((*default-pathname-defaults* (pathname "SYS:")))
+    (assert (not (typep (user-homedir-pathname)
+                        'logical-pathname)))))
+
+(with-test (:name :sbcl-homedir-pathname-robustness)
+  (let ((*default-pathname-defaults* (pathname "SYS:")))
+    (assert (not (typep (sb-impl::sbcl-homedir-pathname)
+                        'logical-pathname)))))
+
+(with-test (:name :file-author-stringp)
+  #-win32
+  (assert (stringp (file-author (user-homedir-pathname))))
+  #+win32
+  (assert (not (file-author (user-homedir-pathname)))))
+(with-test (:name :file-write-date-integerp)
+  (assert (integerp (file-write-date (user-homedir-pathname)))))
+
+;;; Canonicalization of pathnames for DIRECTORY
+(with-test (:name :directory-/.)
+  (assert (equal (directory #p".") (directory #p"./")))
+  (assert (equal (directory #p".") (directory #p""))))
+(with-test (:name :directory-/..)
+  (assert (equal (directory #p"..") (directory #p"../"))))
+(with-test (:name :directory-unspecific)
+  (assert (equal (directory #p".")
+                 (directory (make-pathname
+                             :name :unspecific
+                             :type :unspecific)))))