bug#12216: peek-char incorrectly *CONSUMES* eof

[Mark H Weaver]

Hi Andy,

Andy Wingo <address@hidden> writes:
> Looks like a good start.  Two comments:
>
> On Mon 01 Apr 2013 23:27, Mark H Weaver <address@hidden> writes:
>
> 1. I don't much like the addition of this call to this inline function.
> Can we move all the non-fast-path code into some other function?  That
> would include the flush call as well.

Good idea!  I've posted separate patches to do that here:

  "[PATCH] Move slow path out of 'scm_get_byte_or_eof' et al"
  http://lists.gnu.org/archive/html/guile-devel/2013-04/msg00032.html

> 2. I think we probably need some tests.

I've attached a new patch which adds tests.  Note that this patch
depends upon the "Move slow path out" patches referenced above.

More thoughts?

   Thanks!
     Mark


>From 688dd519d7be102b9d5ce2193883c33d82f8df7b Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Sun, 31 Mar 2013 19:06:51 -0400
Subject: [PATCH] Peeks do not consume EOFs.

Fixes <http://bugs.gnu.org/12216>.

* libguile/ports-internal.h (struct scm_port_internal): Add
  'pending_eof' flag.

* libguile/ports.c (scm_i_set_pending_eof, scm_i_clear_pending_eof): New
  static functions.
  (scm_new_port_table_entry): Initialize 'pending_eof'.
  (scm_i_fill_input): Check for 'pending_eof'.
  (scm_i_peek_byte_or_eof): Set 'pending_eof' flag before returning EOF.
  (scm_end_input, scm_unget_byte, scm_seek): Clear 'pending_eof'.
  (scm_peek_char): Set 'pending_eof' flag before returning EOF.

* test-suite/tests/ports.test ("pending EOF behavior"): Add tests.
---
 libguile/ports-internal.h   |    1 +
 libguile/ports.c            |   37 +++++++++++++++++--
 test-suite/tests/ports.test |   84 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 119 insertions(+), 3 deletions(-)

diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index 73a788f..333d4fb 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -48,6 +48,7 @@ struct scm_port_internal
 {
   scm_t_port_encoding_mode encoding_mode;
   scm_t_iconv_descriptors *iconv_descriptors;
+  int pending_eof;
   SCM alist;
 };
 
diff --git a/libguile/ports.c b/libguile/ports.c
index ee14ca5..61bfc72 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -241,6 +241,18 @@ scm_set_port_input_waiting (scm_t_bits tc, int 
(*input_waiting) (SCM))
   scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting = input_waiting;
 }
 
+static void
+scm_i_set_pending_eof (SCM port)
+{
+  SCM_PORT_GET_INTERNAL (port)->pending_eof = 1;
+}
+
+static void
+scm_i_clear_pending_eof (SCM port)
+{
+  SCM_PORT_GET_INTERNAL (port)->pending_eof = 0;
+}
+
 SCM
 scm_i_port_alist (SCM port)
 {
@@ -645,6 +657,7 @@ scm_new_port_table_entry (scm_t_bits tag)
   entry->input_cd = pti;   /* XXX pointer to the internal port structure */
   entry->output_cd = NULL; /* XXX unused */
 
+  pti->pending_eof = 0;
   pti->alist = SCM_EOL;
 
   SCM_SET_CELL_TYPE (z, tag);
@@ -1423,9 +1436,16 @@ static int
 scm_i_fill_input (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
 
   assert (pt->read_pos == pt->read_end);
 
+  if (pti->pending_eof)
+    {
+      pti->pending_eof = 0;
+      return EOF;
+    }
+
   if (pt->read_buf == pt->putback_buf)
     {
       /* finished reading put-back chars.  */
@@ -1481,7 +1501,10 @@ scm_i_peek_byte_or_eof (SCM port)
   if (pt->read_pos >= pt->read_end)
     {
       if (SCM_UNLIKELY (scm_i_fill_input (port) == EOF))
-       return EOF;
+        {
+          scm_i_set_pending_eof (port);
+          return EOF;
+        }
     }
 
   return *pt->read_pos;
@@ -1713,6 +1736,7 @@ scm_end_input (SCM port)
   long offset;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
+  scm_i_clear_pending_eof (port);
   if (pt->read_buf == pt->putback_buf)
     {
       offset = pt->read_end - pt->read_pos;
@@ -1736,6 +1760,7 @@ scm_unget_byte (int c, SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
+  scm_i_clear_pending_eof (port);
   if (pt->read_buf == pt->putback_buf)
     /* already using the put-back buffer.  */
     {
@@ -1907,7 +1932,10 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
       result = SCM_BOOL_F;
     }
   else if (c == EOF)
-    result = SCM_EOF_VAL;
+    {
+      scm_i_set_pending_eof (port);
+      result = SCM_EOF_VAL;
+    }
   else
     result = SCM_MAKE_CHAR (c);
 
@@ -2006,7 +2034,10 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
        SCM_MISC_ERROR ("port is not seekable", 
                         scm_cons (fd_port, SCM_EOL));
       else
-       rv = ptob->seek (fd_port, off, how);
+        {
+          scm_i_clear_pending_eof (fd_port);
+          rv = ptob->seek (fd_port, off, how);
+        }
       return scm_from_off_t_or_off64_t (rv);
     }
   else /* file descriptor?.  */
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 886ab24..7b6ee22 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1110,6 +1110,90 @@
                (char-ready?))))))
 
 
+;;;; pending-eof behavior
+
+(with-test-prefix "pending EOF behavior"
+  ;; Make a test port that will produce the given sequence.  Each
+  ;; element of 'lst' may be either a character or #f (which means EOF).
+  (define (test-soft-port . lst)
+    (make-soft-port
+     (vector (lambda (c) #f)            ; write char
+             (lambda (s) #f)            ; write string
+             (lambda () #f)             ; flush
+             (lambda ()                 ; read char
+               (let ((c (car lst)))
+                 (set! lst (cdr lst))
+                 c))
+             (lambda () #f))            ; close
+     "rw"))
+
+  (define (call-with-port p proc)
+    (dynamic-wind
+      (lambda () #f)
+      (lambda () (proc p))
+      (lambda () (close-port p))))
+
+  (define (call-with-test-file str proc)
+    (let ((filename (test-file)))
+      (dynamic-wind
+        (lambda () (call-with-output-file filename
+                     (lambda (p) (display str p))))
+        (lambda () (call-with-input-file filename proc))
+        (lambda () (delete-file (test-file))))))
+
+  (pass-if "peek-char does not swallow EOF (soft port)"
+    (call-with-port (test-soft-port #\a #f #\b)
+      (lambda (p)
+        (and (char=? #\a  (peek-char p))
+             (char=? #\a  (read-char p))
+             (eof-object? (peek-char p))
+             (eof-object? (read-char p))
+             (char=? #\b  (peek-char p))
+             (char=? #\b  (read-char p))))))
+
+  (pass-if "unread clears pending EOF (soft port)"
+    (call-with-port (test-soft-port #\a #f #\b)
+      (lambda (p)
+        (and (char=? #\a  (read-char p))
+             (eof-object? (peek-char p))
+             (begin (unread-char #\u p)
+                    (char=? #\u  (read-char p)))))))
+
+  (pass-if "unread clears pending EOF (string port)"
+    (call-with-input-string "a"
+      (lambda (p)
+        (and (char=? #\a  (read-char p))
+             (eof-object? (peek-char p))
+             (begin (unread-char #\u p)
+                    (char=? #\u  (read-char p)))))))
+
+  (pass-if "unread clears pending EOF (file port)"
+    (call-with-test-file
+     "a"
+     (lambda (p)
+       (and (char=? #\a  (read-char p))
+            (eof-object? (peek-char p))
+            (begin (unread-char #\u p)
+                   (char=? #\u  (read-char p)))))))
+
+  (pass-if "seek clears pending EOF (string port)"
+    (call-with-input-string "a"
+      (lambda (p)
+        (and (char=? #\a  (read-char p))
+             (eof-object? (peek-char p))
+             (begin (seek p 0 SEEK_SET)
+                    (char=? #\a (read-char p)))))))
+
+  (pass-if "seek clears pending EOF (file port)"
+    (call-with-test-file
+     "a"
+     (lambda (p)
+       (and (char=? #\a  (read-char p))
+            (eof-object? (peek-char p))
+            (begin (seek p 0 SEEK_SET)
+                   (char=? #\a (read-char p))))))))
+
+
 ;;;; Close current-input-port, and make sure everyone can handle it.
 
 (with-test-prefix "closing current-input-port"
-- 
1.7.10.4