From: Andy Wingo Date: Thu, 22 Jan 2015 13:53:06 +0000 (+0100) Subject: Merge commit 'ed72201a795ac1c8d6c0288b6bb710f2bd0ebd9c' X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/0a5b437ef9063df2a3728338a7cd6b86c4c2e275?hp=e19235e21bad6fdf8c8152dc5b460685b551f330 Merge commit 'ed72201a795ac1c8d6c0288b6bb710f2bd0ebd9c' Conflicts: test-suite/tests/r6rs-ports.test --- diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 1b0aba406..2c2b657d7 100644 --- 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 b387eb350..0d2f3d601 100644 --- 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 17acdc44c..dd4092512 100644 --- 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 . + (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 . + (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)))