bug#30066: 'get-bytevector-some' returns only 1 byte from unbuffered ports

[Ludovic Courtès]

address@hidden (Ludovic Courtès) skribis:

> As discussed on IRC, ‘get-bytevector-some’ returns only 1 byte from
> unbuffered ports:

Here’s a tentative fix.  WDYT?

Ludo’.

diff --git a/libguile/ports.c b/libguile/ports.c
index 72bb73a01..002dd1433 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-2001, 2003-2004, 2006-2017
+/* Copyright (C) 1995-2001, 2003-2004, 2006-2018
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -1543,7 +1543,9 @@ scm_peek_byte_or_eof (SCM port)
   return peek_byte_or_eof (port, &buf, &cur);
 }
 
-static size_t
+/* Like read(2), read *up to* COUNT bytes from PORT into DST, starting
+   at OFFSET.  Return 0 upon EOF.  */
+size_t
 scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t count)
 {
   size_t filled;
diff --git a/libguile/ports.h b/libguile/ports.h
index d131db5be..7aeacc8f9 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -4,7 +4,7 @@
 #define SCM_PORTS_H
 
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- *   2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, 
Inc.
+ *   2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2018 Free Software 
Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -69,6 +69,7 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
 #define SCM_OPOUTPORTP(x) (SCM_OPPORTP (x) && SCM_OUTPUT_PORT_P (x))
 #define SCM_OPENP(x) (SCM_OPPORTP (x))
 #define SCM_CLOSEDP(x) (!SCM_OPENP (x))
+#define SCM_UNBUFFEREDP(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_BUF0))
 #define SCM_CLR_PORT_OPEN_FLAG(p) \
   SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
 #ifdef BUILDING_LIBGUILE
@@ -185,6 +186,8 @@ SCM_API int scm_get_byte_or_eof (SCM port);
 SCM_API int scm_peek_byte_or_eof (SCM port);
 SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
 SCM_API size_t scm_c_read_bytes (SCM port, SCM dst, size_t start, size_t 
count);
+SCM_INTERNAL size_t scm_i_read_bytes (SCM port, SCM dst, size_t start,
+                                     size_t count);
 SCM_API scm_t_wchar scm_getc (SCM port);
 SCM_API SCM scm_read_char (SCM port);
 
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index e944c7aab..a3a67f3ca 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011, 2013-2015 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010, 2011, 2013-2015, 2018 Free Software Foundation, 
Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -487,16 +487,33 @@ SCM_DEFINE (scm_get_bytevector_some, 
"get-bytevector-some", 1, 0, 0,
 
   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 
-  buf = scm_fill_input (port, 0, &cur, &avail);
-  if (avail == 0)
+  if (SCM_UNBUFFEREDP (port))
     {
-      scm_port_buffer_set_has_eof_p (buf, SCM_BOOL_F);
-      return SCM_EOF_VAL;
+      size_t read;
+
+      bv = scm_c_make_bytevector (4096);
+      read = scm_i_read_bytes (port, bv, 0, SCM_BYTEVECTOR_LENGTH (bv));
+
+      if (read == 0)
+       return SCM_EOF_VAL;
+      else if (read < SCM_BYTEVECTOR_LENGTH (bv))
+       return scm_c_shrink_bytevector (bv, read);
+      else
+       return bv;
     }
+  else
+    {
+      buf = scm_fill_input (port, 0, &cur, &avail);
+      if (avail == 0)
+       {
+         scm_port_buffer_set_has_eof_p (buf, SCM_BOOL_F);
+         return SCM_EOF_VAL;
+       }
 
-  bv = scm_c_make_bytevector (avail);
-  scm_port_buffer_take (buf, (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv),
-                        avail, cur, avail);
+      bv = scm_c_make_bytevector (avail);
+      scm_port_buffer_take (buf, (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv),
+                           avail, cur, avail);
+    }
 
   return bv;
 }
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index ba3131f2e..7450b7217 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,6 +1,6 @@
 ;;;; r6rs-ports.test --- R6RS I/O port tests.   -*- coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009-2012, 2013-2015 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2012, 2013-2015, 2018 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -183,6 +183,15 @@
            (equal? (bytevector->u8-list bv)
                    (map char->integer (string->list str))))))
 
+  (pass-if-equal "get-bytevector-some [unbuffered port]"
+      (string->utf8 "Hello, world!")
+    ;; 'get-bytevector-some' used to return a single byte, see
+    ;; <https://bugs.gnu.org/30066>.
+    (call-with-input-string "Hello, world!"
+      (lambda (port)
+        (setvbuf port _IONBF)
+        (get-bytevector-some port))))
+
   (pass-if "get-bytevector-all"
     (let* ((str   "GNU Guile")
            (index 0)