Merge commit '122f24cc8a3637ed42d7792ad1ff8ec0c49c58df'

Conflicts:
	libguile/fports.c
	libguile/ports.c

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 40c20e7..9091d9f 100644 (file)
--- 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 dc3d45c..672f575 100644 (file)
--- 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_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;
 }

diff --git a/libguile/ports.c b/libguile/ports.c
index d8d27cc..c53b7c1 100644 (file)
--- 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.
+/* 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
 
-
 \f
 
 /* The port table --- a weak set of all ports.

diff --git a/libguile/ports.h b/libguile/ports.h
index a7fde39..f2ab850 100644 (file)
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -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);

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 3d0bba5..bad4118 100644 (file)
--- 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
@@ -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.