Actually I see the flush func of a soft port is entirely unused, it's
never called by a force-output because nothing is ever put in the port
buffer as such. The manual could be clearer about what it's supposed to
be for :-(.
At any rate, I put in the failing test below for port-for-each, and I
think flush-all could benefit from the rewrite below, just on general
principles.
--- ports.test 27 Jan 2007 11:06:20 +1100 1.33.2.5
+++ ports.test 22 Aug 2007 16:43:39 +1000
@@ -550,6 +550,38 @@
(eqv? n (port-line port)))))
;;;
+;;; port-for-each
+;;;
+
+(with-test-prefix "port-for-each"
+
+ ;; In guile 1.8.0 through 1.8.2, port-for-each could pass a freed cell to
+ ;; its iterator func if a port was inaccessible in the last gc mark but
+ ;; the lazy sweeping has not yet reached it to remove it from the port
+ ;; table (scm_i_port_table). Provoking those gc conditions is a little
+ ;; tricky, but the following code made it happen in 1.8.2.
+ (pass-if "passing freed cell"
+ (throw 'unresolved)
+ (let ((lst '()))
+ ;; clear out the heap
+ (gc) (gc) (gc)
+ ;; allocate cells so the opened ports aren't at the start of the heap
+ (make-list 1000)
+ (open-input-file "/dev/null")
+ (make-list 1000)
+ (open-input-file "/dev/null")
+ ;; this gc leaves the above ports unmarked, ie. inaccessible
+ (gc)
+ ;; but they're still in the port table, so this sees them
+ (port-for-each (lambda (port)
+ (set! lst (cons port lst))))
+ ;; this forces completion of the sweeping
+ (gc) (gc) (gc)
+ ;; and (if the bug is present) the cells accumulated in LST are now
+ ;; freed cells, which give #f from `port?'
+ (not (memq #f (map port? lst))))))
+
+;;;
;;; seek
;;;
--- ports.c 27 Jan 2007 10:51:48 +1100 1.204.2.14
+++ ports.c 21 Aug 2007 17:02:53 +1000
@@ -929,25 +929,26 @@
}
#undef FUNC_NAME
+
+static void
+scm_flush_all_ports_one (void *dummy, SCM port)
+{
+ if (SCM_OPOUTPORTP (port))
+ scm_flush (port);
+}
+
SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
(),
"Equivalent to calling @code{force-output} on\n"
"all open output ports. The return value is unspecified.")
#define FUNC_NAME s_scm_flush_all_ports
{
- size_t i;
-
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
- for (i = 0; i < scm_i_port_table_size; i++)
- {
- if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
- scm_flush (scm_i_port_table[i]->port);
- }
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+ scm_c_port_for_each (scm_flush_all_ports_one);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
(SCM port),
"Return the next character available from @var{port}, updating\n"
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel
