mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 06:20:30 +02:00
Code Activity

Merge commit 'ed72201a79'

Browse source 
Conflicts:
	test-suite/tests/r6rs-ports.test
This commit is contained in:
Andy Wingo 2015-01-22 14:53:06 +01:00
commit 0a5b437ef9
3 changed files with 49 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/r6rs-ports.c
View file

@ -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

12
module/ice-9/command-line.scm
View file

@ -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.

34
test-suite/tests/r6rs-ports.test
View file

@ -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)))