summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-12 12:04:34 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-25 11:39:38 -0700
commit1008ea315483d1fb41b2a8c10680e511238836d0 (patch)
treeed5099f0818e2f810231eceb4a66e626f2332de6
parentbf060d2affbfea8e7b69d160b8214d791661f236 (diff)
downloadguile-1008ea315483d1fb41b2a8c10680e511238836d0.tar.gz
Allow garbage collection of revealed file ports.
Reported at <https://bugs.gnu.org/28784>. Discussed at <https://lists.gnu.org/archive/html/guile-devel/2017-10/msg00003.html>. * libguile/fports.c (revealed_ports, revealed_lock): Remove. (scm_revealed_count): Just return 'SCM_REVEALED (port)'. (scm_set_port_revealed_x, scm_adjust_port_revealed_x): Remove REVEALED_PORTS manipulation. (fport_close): Do nothing when SCM_REVEALED (port) > 0. * libguile/fports.h (scm_t_fport): Adjust comment; make 'revealed' unsigned. * libguile/ports.c (do_close): Call 'close_port' instead of 'scm_close_port'. (scm_close_port): Rename to... (close_port): ... this. Add 'explicit' parameter. Clear 'revealed' field when PORT is a file port and EXPLICIT is true. (scm_close_port): Call 'close_port'. * test-suite/tests/ports.test ("close-port & revealed port") ("revealed port fdes not closed"): New tests.
-rw-r--r--libguile/fports.c41
-rw-r--r--libguile/fports.h8
-rw-r--r--libguile/ports.c43
-rw-r--r--test-suite/tests/ports.test28
4 files changed, 69 insertions, 51 deletions
diff --git a/libguile/fports.c b/libguile/fports.c
index 94092b872..ee6ac0bf1 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,6 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
* 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
- * 2014, 2015 Free Software Foundation, Inc.
+ * 2014, 2015, 2017 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
@@ -467,8 +467,6 @@ fport_input_waiting (SCM port)
#define SCM_REVEALED(x) (SCM_FSTREAM(x)->revealed)
-static SCM revealed_ports = SCM_EOL;
-static scm_i_pthread_mutex_t revealed_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* Find a port in the table and return its revealed count.
Also used by the garbage collector.
@@ -476,13 +474,7 @@ static scm_i_pthread_mutex_t revealed_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
int
scm_revealed_count (SCM port)
{
- int ret;
-
- scm_i_pthread_mutex_lock (&revealed_lock);
- ret = SCM_REVEALED (port);
- scm_i_pthread_mutex_unlock (&revealed_lock);
-
- return ret;
+ return SCM_REVEALED (port);
}
SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
@@ -503,25 +495,14 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
"The return value is unspecified.")
#define FUNC_NAME s_scm_set_port_revealed_x
{
- int r, prev;
+ int r;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPFPORT (1, port);
r = scm_to_int (rcount);
-
- scm_i_pthread_mutex_lock (&revealed_lock);
-
- prev = SCM_REVEALED (port);
SCM_REVEALED (port) = r;
- if (r && !prev)
- revealed_ports = scm_cons (port, revealed_ports);
- else if (prev && !r)
- revealed_ports = scm_delq_x (port, revealed_ports);
-
- scm_i_pthread_mutex_unlock (&revealed_lock);
-
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -539,18 +520,7 @@ SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
SCM_VALIDATE_OPFPORT (1, port);
a = scm_to_int (addend);
- if (!a)
- return SCM_UNSPECIFIED;
-
- scm_i_pthread_mutex_lock (&revealed_lock);
-
SCM_REVEALED (port) += a;
- if (SCM_REVEALED (port) == a)
- revealed_ports = scm_cons (port, revealed_ports);
- else if (!SCM_REVEALED (port))
- revealed_ports = scm_delq_x (port, revealed_ports);
-
- scm_i_pthread_mutex_unlock (&revealed_lock);
return SCM_UNSPECIFIED;
}
@@ -668,6 +638,11 @@ fport_close (SCM port)
{
scm_t_fport *fp = SCM_FSTREAM (port);
+ if (SCM_REVEALED (port) > 0)
+ /* The port has a non-zero revealed count, so don't close the
+ underlying file descriptor. */
+ return;
+
scm_run_fdes_finalizers (fp->fdes);
if (close (fp->fdes) != 0)
/* It's not useful to retry after EINTR, as the file descriptor is
diff --git a/libguile/fports.h b/libguile/fports.h
index afb8ba771..e397fcc59 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,8 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2001, 2006, 2008, 2009, 2011, 2012,
+ * 2017 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
@@ -33,9 +34,8 @@
typedef struct scm_t_fport {
/* The file descriptor. */
int fdes;
- /* Revealed count; 0 indicates not revealed, > 1 revealed. Revealed
- ports do not get garbage-collected. */
- int revealed;
+ /* Revealed count; 0 indicates not revealed, > 1 revealed. */
+ unsigned int revealed;
/* Set of scm_fport_option flags. */
unsigned options;
} scm_t_fport;
diff --git a/libguile/ports.c b/libguile/ports.c
index 2a25cd58e..72bb73a01 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-2001, 2003-2004, 2006-2016
+/* Copyright (C) 1995-2001, 2003-2004, 2006-2017
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -680,10 +680,12 @@ SCM scm_i_port_weak_set;
/* Port finalization. */
+static SCM close_port (SCM, int);
+
static SCM
do_close (void *data)
{
- return scm_close_port (SCM_PACK_POINTER (data));
+ return close_port (SCM_PACK_POINTER (data), 0);
}
/* Finalize the object (a port) pointed to by PTR. */
@@ -859,19 +861,11 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0,
/* Closing ports. */
-SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
- (SCM port),
- "Close the specified port object. Return @code{#t} if it\n"
- "successfully closes a port or @code{#f} if it was already\n"
- "closed. An exception may be raised if an error occurs, for\n"
- "example when flushing buffered output. See also @ref{Ports and\n"
- "File Descriptors, close}, for a procedure which can close file\n"
- "descriptors.")
-#define FUNC_NAME s_scm_close_port
+/* Close PORT. If EXPLICIT is true, then we are explicitly closing PORT
+ with 'close-port'; otherwise PORT is just being GC'd. */
+static SCM
+close_port (SCM port, int explicit)
{
- port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_PORT (1, port);
-
if (SCM_CLOSEDP (port))
return SCM_BOOL_F;
@@ -879,6 +873,11 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
if (SCM_OUTPUT_PORT_P (port))
scm_flush (port);
+ if (explicit && SCM_FPORTP (port))
+ /* We're closing PORT explicitly so clear its revealed count so that
+ it really gets closed. */
+ SCM_FSTREAM (port)->revealed = 0;
+
SCM_CLR_PORT_OPEN_FLAG (port);
if (SCM_PORT_TYPE (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
@@ -888,6 +887,22 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
return SCM_BOOL_T;
}
+
+SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
+ (SCM port),
+ "Close the specified port object. Return @code{#t} if it\n"
+ "successfully closes a port or @code{#f} if it was already\n"
+ "closed. An exception may be raised if an error occurs, for\n"
+ "example when flushing buffered output. See also @ref{Ports and\n"
+ "File Descriptors, close}, for a procedure which can close file\n"
+ "descriptors.")
+#define FUNC_NAME s_scm_close_port
+{
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_VALIDATE_PORT (1, port);
+
+ return close_port (port, 1);
+}
#undef FUNC_NAME
SCM_DEFINE (scm_close_input_port, "close-input-port", 1, 0, 0,
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 3c8ae3050..6fe38d953 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -602,6 +602,34 @@
(pass-if "unread residue"
(string=? (read-line) "moon"))))
+(pass-if-equal "close-port & revealed port"
+ EBADF
+ (let* ((port (open-file "/dev/null" "r0"))
+ (fdes (port->fdes port))) ;increments revealed count of PORT
+ (close-port port) ;closes FDES as a side-effect
+ (catch 'system-error
+ (lambda ()
+ (seek fdes 0 SEEK_CUR)
+ #f)
+ (lambda args
+ (system-error-errno args)))))
+
+(pass-if "revealed port fdes not closed"
+ (let* ((port (open-file "/dev/null" "r0"))
+ (fdes (port->fdes port)) ;increments revealed count of PORT
+ (guardian (make-guardian)))
+ (guardian port)
+ (set! port #f)
+ (gc)
+ (if (port? (guardian))
+ (and (zero? (seek fdes 0 SEEK_CUR))
+ (begin
+ (close-fdes fdes)
+ #t))
+ (begin
+ (close-fdes fdes)
+ (throw 'unresolved)))))
+
(when (provided? 'threads)
(let* ((p (pipe))
(r (car p))