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 + ;; . + (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)