X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Fsimple-stream-tests.lisp;h=010d0abf036830b1a6d03ec1d8a856f60d429503;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=735b1547baa5d868c30b27a638a95dd0ac9c391b;hpb=59f1de77587818635573073a14ce80c2d398f56c;p=sbcl.git

diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp
index 735b154..010d0ab 100644
--- a/contrib/sb-simple-streams/simple-stream-tests.lisp
+++ b/contrib/sb-simple-streams/simple-stream-tests.lisp
@@ -7,7 +7,7 @@
 (in-package #:sb-simple-streams-test)
 
 (defparameter *dumb-string*
-  "This file created by simple-stream-tests.lisp. Nothing to see here, move along.")
+  "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
 
 (defparameter *test-path*
   (merge-pathnames (make-pathname :name nil :type nil :version nil)
@@ -16,6 +16,28 @@
 
 (eval-when (:load-toplevel) (ensure-directories-exist *test-path*))
 
+(defmacro with-test-file ((stream file &rest open-arguments
+                                  &key (delete-afterwards t)
+                                  initial-content
+                                  &allow-other-keys)
+                          &body body)
+  (remf open-arguments :delete-afterwards)
+  (remf open-arguments :initial-content)
+  (if initial-content
+      (let ((create-file-stream (gensym)))
+        `(progn
+           (with-open-file (,create-file-stream ,file :direction :output
+                                                :if-exists :supersede
+                                                :if-does-not-exist :create)
+             (write-sequence ,initial-content ,create-file-stream))
+           (unwind-protect
+                (with-open-file (,stream ,file ,@open-arguments)
+                  (progn ,@body))
+             ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
+      `(unwind-protect
+            (with-open-file (,stream ,file ,@open-arguments)
+              (progn ,@body))
+         ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
 
 
 (deftest create-file-1
@@ -25,7 +47,8 @@
         (with-open-stream (s (make-instance 'file-simple-stream
                                             :filename file
                                             :direction :output
-                                            :if-exists :overwrite))
+                                            :if-exists :overwrite
+                                            :if-does-not-exist :create))
           (string= (write-string *dumb-string* s) *dumb-string*))
       (delete-file file)))
   t)
@@ -33,29 +56,24 @@
 (deftest create-file-2
   ;; Create a file-simple-stream via :class argument to open, write data.
   (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (prog1
-        (with-open-file (s file
-                           :class 'file-simple-stream
-                           :direction :output :if-exists :overwrite)
-           (string= (write-string *dumb-string* s) *dumb-string*))
-      (delete-file file)))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :overwrite :if-does-not-exist :create)
+      (string= (write-string *dumb-string* s) *dumb-string*)))
   t)
 
 (deftest create-read-file-1
   ;; Via file-simple-stream objects, write and then re-read data.
   (let ((result t)
         (file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :output
-                                        :if-exists :overwrite))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :overwrite :if-does-not-exist :create
+                       :delete-afterwards nil)
       (write-line *dumb-string* s)
       (setf result (and result (string= (write-string *dumb-string* s)
                                         *dumb-string*))))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :input
-                                        :if-does-not-exist :error))
+
+    (with-test-file (s file :class 'file-simple-stream
+                       :direction :input :if-does-not-exist :error)
       ;; Check first line
       (multiple-value-bind (string missing-newline-p)
           (read-line s)
@@ -66,7 +84,6 @@
           (read-line s)
         (setf result (and result (string= string *dumb-string*)
                           missing-newline-p))))
-    (delete-file file)
     result)
   t)
 
@@ -74,16 +91,10 @@
   ;; Read data via a mapped-file-simple-stream object.
   (let ((result t)
         (file (merge-pathnames #p"test-data.txt" *test-path*)))
-    (with-open-file (s file
-                       :class 'file-simple-stream
-                       :direction :output :if-exists :overwrite)
-       (setf result (and result (string= (write-string *dumb-string* s)
-                                         *dumb-string*))))
-    (with-open-file (s file
-                       :class 'mapped-file-simple-stream
-                       :direction :input)
-       (setf result (and result (string= (read-line s) *dumb-string*))))
-    (delete-file file)
+    (with-test-file (s file :class 'mapped-file-simple-stream
+                       :direction :input :if-does-not-exist :error
+                       :initial-content *dumb-string*)
+      (setf result (and result (string= (read-line s) *dumb-string*))))
     result)
   t)
 
@@ -102,17 +113,16 @@
   ;; (single-channel simple-stream)
   (let* ((file (merge-pathnames #p"test-data.txt" *test-path*))
          (stream (make-instance 'file-simple-stream
-                                :filename file
-                                :direction :output))
+                                :filename file :direction :output
+                                :if-exists :overwrite
+                                :if-does-not-exist :create))
          (content (make-string (1+ (device-buffer-length stream))
                                :initial-element #\x)))
     (with-open-stream (s stream)
       (write-string content s))
-    (with-open-stream (s (make-instance 'file-simple-stream
-                                        :filename file
-                                        :direction :input))
-      (prog1 (string= content (read-line s))
-        (delete-file file))))
+    (with-test-file (s file :class 'file-simple-stream
+                       :direction :input :if-does-not-exist :error)
+      (string= content (read-line s))))
   t)
 
 (deftest write-read-large-dc-1
@@ -130,3 +140,121 @@
    (sb-bsd-sockets::connection-refused-error () t))
   t)
 
+
+(deftest file-position-1
+  ;; Test reading of file-position
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :input
+                       :initial-content *dumb-string*)
+      (file-position s)))
+  0)
+
+;;; file-position-2 fails ONLY when called with
+;;; (asdf:oos 'asdf:test-op :sb-simple-streams)
+;;; TODO: Find out why
+#+nil
+(deftest file-position-2
+  ;; Test reading of file-position
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :input
+                       :initial-content *dumb-string*)
+      (read-byte s)
+      (file-position s)))
+  1)
+
+(deftest file-position-3
+  ;; Test reading of file-position in the presence of unsaved data
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :output
+                       :if-exists :supersede :if-does-not-exist :create)
+      (write-byte 50 s)
+      (file-position s)))
+  1)
+
+(deftest file-position-4
+    ;; Test file position when opening with :if-exists :append
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :append :if-does-not-exist :create
+                         :initial-content "Foo")
+        (= (file-length s) (file-position s))))
+  T)
+
+(deftest write-read-unflushed-sc-1
+  ;; Write something into a single-channel stream and read it back
+  ;; without explicitly flushing the buffer in-between
+  (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+    (with-test-file (s file :class 'file-simple-stream :direction :io
+                       :if-does-not-exist :create :if-exists :supersede)
+      (write-char #\x s)
+      (file-position s :start)
+      (read-char s)))
+  #\x)
+
+(deftest write-read-unflushed-sc-2
+  ;; Write something into a single-channel stream, try to read back too much
+  (handler-case
+   (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+     (with-test-file (s file :class 'file-simple-stream :direction :io
+                        :if-does-not-exist :create :if-exists :supersede)
+       (write-char #\x s)
+       (file-position s :start)
+       (read-char s)
+       (read-char s))
+     nil)
+    (end-of-file () t))
+  t)
+
+(deftest write-read-unflushed-sc-3
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*))
+          (result t))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :overwrite :if-does-not-exist :create
+                         :initial-content *dumb-string*)
+        (setq result (and result (char= (read-char s) (char *dumb-string* 0))))
+        (setq result (and result (= (file-position s) 1)))
+        (let ((pos (file-position s)))
+          (write-char #\x s)
+          (file-position s pos)
+          (setq result (and result (char= (read-char s) #\x)))))
+      result)
+  t)
+
+(deftest write-read-unflushed-sc-4
+    ;; Test flushing of buffers
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :overwrite :if-does-not-exist :create
+                         :initial-content "Foo"
+                         :delete-afterwards nil)
+        (read-char s)                   ; Fill the buffer.
+        (file-position s :start)        ; Change existing data.
+        (write-char #\X s)
+        (file-position s :end)          ; Extend file.
+        (write-char #\X s))
+      (with-test-file (s file :class 'file-simple-stream :direction :input
+                         :if-does-not-exist :error)
+        (read-line s)))
+  "XooX"
+  T)
+
+(deftest write-read-append-sc-1
+    ;; Test writing in the middle of a stream opened in append mode
+    (let ((file (merge-pathnames #p"test-data.txt" *test-path*)))
+      (with-test-file (s file :class 'file-simple-stream :direction :io
+                         :if-exists :append :if-does-not-exist :create
+                         :initial-content "Foo"
+                         :delete-afterwards nil)
+        (file-position s :start)        ; Jump to beginning.
+        (write-char #\X s)
+        (file-position s :end)          ; Extend file.
+        (write-char #\X s))
+      (with-test-file (s file :class 'file-simple-stream :direction :input
+                         :if-does-not-exist :error)
+        (read-line s)))
+  "XooX"
+  T)
+
+
+
+