diff options
-rw-r--r-- | doc/ref/posix.texi | 3 | ||||
-rw-r--r-- | libguile/fports.c | 42 | ||||
-rw-r--r-- | libguile/ports-internal.h | 14 | ||||
-rw-r--r-- | libguile/ports.c | 8 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 14 |
5 files changed, 62 insertions, 19 deletions
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index b3a6a048f..56f5c78fc 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -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] diff --git a/libguile/fports.c b/libguile/fports.c index 70732e5a0..365d3ffe0 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -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_port_internal *pti; port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); + SCM_VALIDATE_OPENPORT (1, port); + pti = SCM_PORT_GET_INTERNAL (port); + + if (pti->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); + pti->setvbuf (port, csize, csize); if (ndrained > 0) /* Put DRAINED back to PORT. */ @@ -542,6 +548,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) { SCM port; scm_t_port *pt; + scm_t_port_internal *pti; /* Test that fdes is valid. */ #ifdef F_GETFL @@ -567,7 +574,12 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) port = scm_new_port_table_entry (scm_tc16_fport); SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY(port); + pt = SCM_PTAB_ENTRY (port); + + /* File ports support 'setvbuf'. */ + pti = SCM_PORT_GET_INTERNAL (port); + pti->setvbuf = scm_fport_buffer_add; + { scm_t_fport *fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h index 8a3a00bc9..48dcaa796 100644 --- a/libguile/ports-internal.h +++ b/libguile/ports-internal.h @@ -1,7 +1,7 @@ /* * ports-internal.h - internal-only declarations for ports. * - * Copyright (C) 2013 Free Software Foundation, Inc. + * Copyright (C) 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 @@ -50,7 +50,17 @@ struct scm_port_internal unsigned at_stream_start_for_bom_write : 1; scm_t_port_encoding_mode encoding_mode; scm_t_iconv_descriptors *iconv_descriptors; - int pending_eof; + unsigned char pending_eof: 1; + + /* 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. */ + /* XXX: In 2.2 make this a property of the 'scm_t_ptob_descriptor'. */ + void (*setvbuf) (SCM port, long read_size, long write_size); + + /* Key-value properties. */ SCM alist; }; diff --git a/libguile/ports.c b/libguile/ports.c index 451616069..4f401de5a 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -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. + * 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 @@ -677,6 +677,12 @@ scm_new_port_table_entry (scm_t_bits tag) pti->pending_eof = 0; pti->alist = SCM_EOL; + /* Until Guile 2.0.9 included, 'setvbuf' would only work on file + ports. Now all port types can be supported, but it's not clear + that port types out in wild accept having someone else fiddle with + their buffer. Thus, conservatively turn it off by default. */ + pti->setvbuf = NULL; + SCM_SET_CELL_TYPE (z, tag); SCM_SETPTAB_ENTRY (z, entry); diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 9b1c6c0fc..c2f4480f8 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -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 @@ -1499,6 +1499,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. |