mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Ludovic Courtès
parent
bf060d2aff
commit
1008ea3154
4 changed files with 72 additions and 54 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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,6 +861,33 @@ SCM_DEFINE (scm_eof_object_p, "eof-object?", 1, 0, 0,
|
|||
|
||||
/* Closing ports. */
|
||||
|
||||
/* 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)
|
||||
{
|
||||
if (SCM_CLOSEDP (port))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
/* May throw an exception. */
|
||||
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)
|
||||
scm_weak_set_remove_x (scm_i_port_weak_set, port);
|
||||
|
||||
release_port (port);
|
||||
|
||||
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"
|
||||
|
|
@ -872,21 +901,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
|
|||
port = SCM_COERCE_OUTPORT (port);
|
||||
SCM_VALIDATE_PORT (1, port);
|
||||
|
||||
if (SCM_CLOSEDP (port))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
/* May throw an exception. */
|
||||
if (SCM_OUTPUT_PORT_P (port))
|
||||
scm_flush (port);
|
||||
|
||||
SCM_CLR_PORT_OPEN_FLAG (port);
|
||||
|
||||
if (SCM_PORT_TYPE (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
|
||||
scm_weak_set_remove_x (scm_i_port_weak_set, port);
|
||||
|
||||
release_port (port);
|
||||
|
||||
return SCM_BOOL_T;
|
||||
return close_port (port, 1);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue