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.

1 files changed, 8 insertions, 33 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