mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-29 14:30:34 +02:00
commit
0a5b437ef9
3 changed files with 49 additions and 14 deletions
|
@ -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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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)
|
switch (read_size)
|
||||||
{
|
{
|
||||||
case 0:
|
case 0:
|
||||||
/* Unbuffered: keep PORT's bytevector as is (it will be used in
|
/* Unbuffered: keep using PORT's bytevector as the underlying
|
||||||
future 'scm_c_read' calls), but point to the one-byte buffer. */
|
buffer (it will also be used by future 'scm_c_read' calls.) */
|
||||||
pt->read_buf = &pt->shortbuf;
|
assert (SCM_BYTEVECTOR_LENGTH (bv) >= 1);
|
||||||
|
pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
|
||||||
pt->read_buf_size = 1;
|
pt->read_buf_size = 1;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -385,9 +386,11 @@ cbip_fill_input (SCM port)
|
||||||
|
|
||||||
if (buffered)
|
if (buffered)
|
||||||
{
|
{
|
||||||
/* Make sure the buffer isn't corrupt. BV can be passed directly
|
/* Make sure the buffer isn't corrupt. Its size can be 1 when
|
||||||
to READ_PROC. */
|
someone called 'setvbuf' with _IONBF. BV can be passed
|
||||||
assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv));
|
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);
|
c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Parsing Guile's command-line
|
;;; 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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; 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?
|
(let ((port (if fatal?
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
(current-output-port))))
|
(current-output-port))))
|
||||||
(if fmt
|
(when fmt
|
||||||
(apply format port fmt args))
|
(apply format port fmt args)
|
||||||
|
(newline port))
|
||||||
|
|
||||||
(format port (_ "Usage: ~a [OPTION]... [FILE]...\n") name)
|
(format port (_ "Usage: ~a [OPTION]... [FILE]...\n") name)
|
||||||
(display *usage* port)
|
(display *usage* port)
|
||||||
|
@ -203,7 +204,8 @@ If FILE begins with `-' the -s switch is mandatory.
|
||||||
(turn-off-debugging? #f))
|
(turn-off-debugging? #f))
|
||||||
|
|
||||||
(define (error fmt . args)
|
(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)
|
(define (parse args out)
|
||||||
(cond
|
(cond
|
||||||
|
@ -405,7 +407,7 @@ If FILE begins with `-' the -s switch is mandatory.
|
||||||
(exit 0))
|
(exit 0))
|
||||||
|
|
||||||
(else
|
(else
|
||||||
(error "Unrecognized switch ~a" arg)))))))
|
(error "unrecognized switch ~a" arg)))))))
|
||||||
|
|
||||||
(define (finish args out)
|
(define (finish args out)
|
||||||
;; Check to make sure the -ds got a -s.
|
;; Check to make sure the -ds got a -s.
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
|
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
|
;;;; Copyright (C) 2009-2012, 2013-2015 Free Software Foundation, Inc.
|
||||||
;;;; 2014 Free Software Foundation, Inc.
|
|
||||||
;;;; Ludovic Courtès
|
;;;; Ludovic Courtès
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
|
@ -557,6 +556,37 @@ not `set-port-position!'"
|
||||||
obj))
|
obj))
|
||||||
ret)))))
|
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"
|
(pass-if-equal "custom binary input port, unbuffered then buffered"
|
||||||
`((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…")
|
`((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…")
|
||||||
(777 ,(eof-object)))
|
(777 ,(eof-object)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue