mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge commit '122f24cc8a'

Browse source 
Conflicts:
	libguile/fports.c
	libguile/ports.c
This commit is contained in:
Andy Wingo 2014-02-07 14:39:01 +01:00
commit e140d85d53
5 changed files with 55 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/ref/posix.texi
View file

@ -470,6 +470,9 @@ line buffered
block buffered, using a newly allocated buffer of @var{size} bytes.
If @var{size} is omitted, a default size will be used.
@end defvar
Only certain types of ports are supported, most importantly
file ports.
@end deffn
@deffn {Scheme Procedure} fcntl port/fd cmd [value]

35
libguile/fports.c
View file

@ -1,5 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
* 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
* 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
* 2014 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
@ -58,6 +59,7 @@
#include "libguile/hashtab.h"
#include "libguile/fports.h"
#include "libguile/ports-internal.h"
#if SIZEOF_OFF_T == SIZEOF_INT
#define OFF_T_MAX INT_MAX
@ -78,10 +80,10 @@ scm_t_bits scm_tc16_fport;
/* default buffer size, used if the O/S won't supply a value. */
static const size_t default_buffer_size = 1024;
/* create FPORT buffer with specified sizes (or -1 to use default size or
0 for no buffer. */
/* Create FPORT buffers with specified sizes (or -1 to use default size
or 0 for no buffer.) */
static void
scm_fport_buffer_add (SCM port, long read_size, int write_size)
scm_fport_buffer_add (SCM port, long read_size, long write_size)
#define FUNC_NAME "scm_fport_buffer_add"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
@ -147,7 +149,9 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
"@item _IOFBF\n"
"block buffered, using a newly allocated buffer of @var{size} bytes.\n"
"If @var{size} is omitted, a default size will be used.\n"
"@end table")
"@end table\n\n"
"Only certain types of ports are supported, most importantly\n"
"file ports.")
#define FUNC_NAME s_scm_setvbuf
{
int cmode;
@ -155,10 +159,17 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
size_t ndrained;
char *drained;
scm_t_port *pt;
scm_t_ptob_descriptor *ptob;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1,port);
SCM_VALIDATE_OPENPORT (1, port);
ptob = SCM_PORT_DESCRIPTOR (port);
if (ptob->setvbuf == NULL)
scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
"port that supports 'setvbuf'");
cmode = scm_to_int (mode);
if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
scm_out_of_range (FUNC_NAME, mode);
@ -169,9 +180,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
cmode = _IOFBF;
}
else
{
SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE);
}
SCM_SET_CELL_WORD_0 (port,
SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
if (SCM_UNBNDP (size))
{
@ -216,12 +226,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
pt->read_end = pt->saved_read_end;
pt->read_buf_size = pt->saved_read_buf_size;
}
if (pt->read_buf != &pt->shortbuf)
scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
if (pt->write_buf != &pt->shortbuf)
scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
scm_fport_buffer_add (port, csize, csize);
ptob->setvbuf (port, csize, csize);
if (ndrained > 0)
/* Put DRAINED back to PORT. */
@ -974,6 +980,7 @@ scm_make_fptob ()
scm_set_port_seek (tc, fport_seek);
scm_set_port_truncate (tc, fport_truncate);
scm_set_port_input_waiting (tc, fport_input_waiting);
scm_set_port_setvbuf (tc, scm_fport_buffer_add);
return tc;
}

11
libguile/ports.c
View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
* 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
* 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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
@ -331,6 +331,12 @@ scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM))
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
}
void
scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM, long, long))
{
scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
}
static void
scm_i_set_pending_eof (SCM port)
{
@ -622,7 +628,6 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
}
#undef FUNC_NAME
/* The port table --- a weak set of all ports.

11
libguile/ports.h
View file

@ -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 Free Software Foundation, Inc.
* 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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
@ -200,6 +200,13 @@ typedef struct scm_t_ptob_descriptor
scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
void (*truncate) (SCM port, scm_t_off length);
/* When non-NULL, this is the method called by 'setvbuf' for this port.
It must create read and write buffers for PORT with the specified
sizes (a size of 0 is for unbuffered ports, which should use the
'shortbuf' field.) Size -1 means to use the port's preferred buffer
size. */
void (*setvbuf) (SCM port, long read_size, long write_size);
unsigned flags;
} scm_t_ptob_descriptor;
@ -238,6 +245,8 @@ SCM_API void scm_set_port_truncate (scm_t_bits tc,
void (*truncate) (SCM port,
scm_t_off length));
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM));
SCM_API void scm_set_port_setvbuf (scm_t_bits tc,
void (*setvbuf) (SCM, long, long));
/* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void);

14
test-suite/tests/ports.test
View file

@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; 2011, 2012, 2013, 2014 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
@ -1468,6 +1468,18 @@
(with-test-prefix "setvbuf"
(pass-if-exception "closed port"
exception:wrong-type-arg
(let ((port (open-input-file "/dev/null")))
(close-port port)
(setvbuf port _IOFBF)))
(pass-if-exception "string port"
exception:wrong-type-arg
(let ((port (open-input-string "Hey!")))
(close-port port)
(setvbuf port _IOFBF)))
(pass-if "line/column number preserved"
;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
;; line and/or column number.