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

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index 4a5d0be..e9abce8 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -84,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))))