X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=00382ab3e92b83c75233de2bc585b34542141dbe;hb=31f68584d0732dc0d17f379773e5f87f1e5a78ad;hp=4be0257a87c2dcb74d693666fe67eaf5136dfaba;hpb=0567612118d44cde39bb41058a4d06e771fcf0c6;p=sbcl.git

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index 4be0257..00382ab 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
@@ -94,6 +93,15 @@
   (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR")))
   (assert (equal "C:\\FOO\\BAR" (native-namestring "C:\\FOO\\BAR\\" :as-file t))))
 
+(with-test (:name (:parse-native-pathname :as-directory :junk-allowed))
+  (assert
+   (equal
+    (parse-native-namestring "foo.lisp" nil *default-pathname-defaults*
+                             :as-directory t)
+    (parse-native-namestring "foo.lisp" nil *default-pathname-defaults*
+                             :as-directory t
+                             :junk-allowed t))))
+
 ;;; Test for NATIVE-PATHNAME / NATIVE-NAMESTRING stuff
 ;;;
 ;;; given only safe characters in the namestring, NATIVE-PATHNAME will
@@ -183,3 +191,62 @@
                  (directory (make-pathname
                              :name :unspecific
                              :type :unspecific)))))
+
+;;; Generated with
+;;; (loop for exist in '(nil t)
+;;;       append
+;;;       (loop for (if-exists if-does-not-exist) in '((nil :error)
+;;;                                                    (:error nil)
+;;;                                                    (nil nil)
+;;;                                                    (:error :error))
+;;;             collect (list 'do-open exist if-exists if-does-not-exist)))
+(with-test (:name :open-never-openning)
+  (flet ((do-open (existing if-exists if-does-not-exist
+                   &optional (direction :output))
+           (open (if existing
+                     #.(or *compile-file-truename* *load-truename*)
+                     "a-really-non-existing-file")
+                 :direction direction
+                 :if-exists if-exists :if-does-not-exist if-does-not-exist)))
+    (assert (raises-error?
+             (do-open nil nil :error)))
+    (assert (not
+             (do-open nil :error nil)))
+    (assert (not
+             (do-open t nil :error)))
+    (assert (raises-error?
+             (do-open t :error nil)))
+    (assert (not
+             (do-open nil nil nil)))
+    (assert (raises-error?
+             (do-open nil :error :error)))
+    (assert (not
+             (do-open t nil nil)))
+    (assert (raises-error? (do-open t :error :error)))
+
+    (assert (raises-error?
+             (do-open nil nil :error :io)))
+    (assert (not
+             (do-open nil :error nil :io)))
+    (assert (not
+             (do-open t nil :error :io)))
+    (assert (raises-error?
+             (do-open t :error nil :io)))
+    (assert (not
+             (do-open nil nil nil :io)))
+    (assert (raises-error?
+             (do-open nil :error :error :io)))
+    (assert (not
+             (do-open t nil nil :io)))
+    (assert (raises-error? (do-open t :error :error :io)))))
+
+(with-test (:name :open-new-version)
+  (multiple-value-bind (value error)
+      (ignore-errors (open #.(or *compile-file-truename* *load-truename*)
+                           :direction :output
+                           :if-exists :new-version))
+    (assert (not value))
+    (assert error)
+    (assert (equal (simple-condition-format-control error)
+                   "OPEN :IF-EXISTS :NEW-VERSION is not supported ~
+                            when a new version must be created."))))