Merge commit 'ed72201a795ac1c8d6c0288b6bb710f2bd0ebd9c'

Conflicts:
	test-suite/tests/r6rs-ports.test

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 1b0aba4..2c2b657 100644 (file)
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010, 2011, 2013-2015 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
@@ -299,9 +299,10 @@ cbip_setvbuf (SCM port, long read_size, long write_size)
   switch (read_size)
     {
     case 0:
-      /* Unbuffered: keep PORT's bytevector as is (it will be used in
-        future 'scm_c_read' calls), but point to the one-byte buffer.  */
-      pt->read_buf = &pt->shortbuf;
+      /* Unbuffered: keep using PORT's bytevector as the underlying
+        buffer (it will also be used by future 'scm_c_read' calls.)  */
+      assert (SCM_BYTEVECTOR_LENGTH (bv) >= 1);
+      pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
       pt->read_buf_size = 1;
       break;
 
@@ -385,9 +386,11 @@ cbip_fill_input (SCM port)
 
       if (buffered)
        {
-         /* Make sure the buffer isn't corrupt.  BV can be passed directly
-            to READ_PROC.  */
-         assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv));
+         /* Make sure the buffer isn't corrupt.  Its size can be 1 when
+            someone called 'setvbuf' with _IONBF.  BV can be passed
+            directly to READ_PROC.  */
+         assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)
+                 || c_port->read_buf_size == 1);
          c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
        }
       else

diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index b387eb3..0d2f3d6 100644 (file)
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -1,6 +1,6 @@
 ;;; Parsing Guile's command-line
 
-;;; Copyright (C) 1994-1998, 2000-2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 1994-1998, 2000-2015 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
@@ -147,8 +147,9 @@ If FILE begins with `-' the -s switch is mandatory.
   (let ((port (if fatal?
                   (current-error-port)
                   (current-output-port))))
-    (if fmt
-        (apply format port fmt args))
+    (when fmt
+      (apply format port fmt args)
+      (newline port))
 
     (format port (_ "Usage: ~a [OPTION]... [FILE]...\n") name)
     (display *usage* port)
@@ -203,7 +204,8 @@ If FILE begins with `-' the -s switch is mandatory.
         (turn-off-debugging? #f))
 
     (define (error fmt . args)
-      (apply shell-usage usage-name #t fmt args))
+      (apply shell-usage usage-name #t
+             (string-append "error: " fmt "~%") args))
 
     (define (parse args out)
       (cond
@@ -405,7 +407,7 @@ If FILE begins with `-' the -s switch is mandatory.
             (exit 0))
 
            (else
-            (error "Unrecognized switch ~a" arg)))))))
+            (error "unrecognized switch ~a" arg)))))))
 
     (define (finish args out)
       ;; Check to make sure the -ds got a -s.

diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 17acdc4..dd40925 100644 (file)
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,7 +1,6 @@
 ;;;; r6rs-ports.test --- R6RS I/O port tests.   -*- coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
-;;;;   2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2012, 2013-2015 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -557,6 +556,37 @@ not `set-port-position!'"
                         obj))
                   ret)))))
 
+  (pass-if-equal "custom binary input port unbuffered & 'get-string-all'"
+      (make-string 1000 #\a)
+    ;; In Guile 2.0.11 this test would lead to a buffer overrun followed
+    ;; by an assertion failure.  See <http://bugs.gnu.org/19621>.
+    (let* ((input (with-fluids ((%default-port-encoding #f))
+                    (open-input-string (make-string 1000 #\a))))
+           (read! (lambda (bv index count)
+                    (let ((n (get-bytevector-n! input bv index
+                                                count)))
+                      (if (eof-object? n) 0 n))))
+           (port  (make-custom-binary-input-port "foo" read!
+                                                 #f #f #f)))
+      (setvbuf port _IONBF)
+      (get-string-all port)))
+
+  (pass-if-equal "custom binary input port unbuffered UTF-8 & 'get-string-all'"
+      (make-string 1000 #\λ)
+    ;; In Guile 2.0.11 this test would lead to a buffer overrun followed
+    ;; by an assertion failure.  See <http://bugs.gnu.org/19621>.
+    (let* ((input (with-fluids ((%default-port-encoding "UTF-8"))
+                    (open-input-string (make-string 1000 #\λ))))
+           (read! (lambda (bv index count)
+                    (let ((n (get-bytevector-n! input bv index
+                                                count)))
+                      (if (eof-object? n) 0 n))))
+           (port  (make-custom-binary-input-port "foo" read!
+                                                 #f #f #f)))
+      (setvbuf port _IONBF)
+      (set-port-encoding! port "UTF-8")
+      (get-string-all port)))
+
   (pass-if-equal "custom binary input port, unbuffered then buffered"
       `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…")
         (777 ,(eof-object)))