X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=00382ab3e92b83c75233de2bc585b34542141dbe;hb=HEAD;hp=ec4c35e6073d92d482441929572d3c6baaf53c6b;hpb=0e4b15d65c46653b1ea222dcbf12d635d59b36c7;p=sbcl.git diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index ec4c35e..00382ab 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -107,7 +107,7 @@ ;;; given only safe characters in the namestring, NATIVE-PATHNAME will ;;; never error, and NATIVE-NAMESTRING on the result will return the ;;; original namestring. -(with-test (:name :random-native-namestrings :fails-on :win32) +(with-test (:name :random-native-namestrings) (let ((safe-chars (coerce (cons #\Newline @@ -191,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."))))