X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=e9abce8496e15d1aa015fe9940604f5c4e48908e;hb=fec3614baf361523a4fb154ed80d9b73e1452b2d;hp=cdac2f3eda46c077433bf952e6be995a3ad016ec;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index cdac2f3..e9abce8 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -35,6 +35,15 @@
                      (search "tests/filesys.pure.lisp"
                              (namestring pathname)))
                    dir)))
+;;; In sbcl-0.9.7 DIRECTORY failed on pathnames with character-set
+;;; components.
+(let ((dir (directory "[f]*.*")))
+  ;; 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 "filesys.pure.lisp"
+                             (namestring pathname)))
+                   dir)))
 
 ;;; Set *default-pathname-defaults* to something other than the unix
 ;;; cwd, to catch functions which access the filesystem without
@@ -75,3 +84,48 @@
 ;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.)
 (assert (typep (nth-value 1 (ignore-errors (file-length *terminal-io*)))
                'type-error))
+
+;;; Test for NATIVE-PATHNAME / NATIVE-NAMESTRING stuff
+;;;
+;;; given only safe characters in the namestring, NATIVE-PATHNAME will
+;;; never error, and NATIVE-NAMESTRING on the result will return the
+;;; original namestring.
+(let ((safe-chars
+       ;; for WIN32, we might want to remove #\: here
+       (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
+                                         (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 nnn = (native-namestring pathname)
+        do (assert (string= nnn native-namestring))))