From: William Halliburton <whalliburton@gmail.com>
Date: Sun, 13 Feb 2011 19:01:17 +0000 (-0700)
Subject: fix initial FILE-POSITION for OPEN :IF-EXISTS :APPEND
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b021c15b8d8e4ea4740323eaee9535c4e7cb2232;p=sbcl.git

fix initial FILE-POSITION for OPEN :IF-EXISTS :APPEND

  For O_APPEND opened files, lseek returns 0 until first write.
  So we jump ahead initially.

  lp#561642
---

diff --git a/NEWS b/NEWS
index 82484cb..ff52c7d 100644
--- a/NEWS
+++ b/NEWS
@@ -33,6 +33,8 @@ changes relative to sbcl-1.0.50:
     type information associated with the VALUES form.
   * bug fix: broken warnings/errors for type-errors involving LOAD-TIME-VALUE
     forms. (lp#823014)
+  * bug fix: OPEN :IF-EXISTS :APPEND now returns correct FILE-POSITION before
+    first write (lp#561642).
 
 changes in sbcl-1.0.50 relative to sbcl-1.0.49:
   * enhancement: errors from FD handlers now provide a restart to remove
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 7fda172..69505b8 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -2424,6 +2424,10 @@
             (cond ((numberp fd)
                    (case direction
                      ((:input :output :io)
+                      ;; For O_APPEND opened files, lseek returns 0 until first write.
+                      ;; So we jump ahead here.
+                      (when (eq if-exists :append)
+                        (sb!unix:unix-lseek fd 0 sb!unix:l_xtnd))
                       (make-fd-stream fd
                                       :input input
                                       :output output
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 32f7716..64db7ed 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -276,6 +276,7 @@ corresponds to NAME, or NIL if there is none."
   (void-syscall ("access" c-string int) path mode))
 
 ;;; values for the second argument to UNIX-LSEEK
+;;; Note that nowadays these are called SEEK_SET, SEEK_CUR, and SEEK_END
 (defconstant l_set 0) ; to set the file pointer
 (defconstant l_incr 1) ; to increment the file pointer
 (defconstant l_xtnd 2) ; to extend the file size
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 6f2e0f4..fd3f8df 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -707,4 +707,29 @@
              (assert (eql (file-length f) 9))))
       (ignore-errors (delete-file name)))))
 
+(with-test (:name :bug-561642)
+  (let ((p "bug-561642-test.tmp"))
+    (unwind-protect
+         (progn
+           (with-open-file (f p
+                              :if-exists :supersede
+                              :if-does-not-exist :create
+                              :direction :output)
+             (write-line "FOOBAR" f))
+           (with-open-file (f p
+                              :if-exists :append
+                              :direction :output)
+             (let ((p0 (file-position f))
+                   (p1 (progn
+                         (write-char #\newline f)
+                         (file-position f)))
+                   (p2 (progn
+                         (write-char #\newline f)
+                         (finish-output f)
+                         (file-position f))))
+               (assert (eql 7 p0))
+               (assert (eql 8 p1))
+               (assert (eql 9 p2)))))
+      (ignore-errors (delete-file p)))))
+
 ;;; success