diff --git a/libguile/fports.c b/libguile/fports.c index 6019d9ec3..4a3c30b88 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2004,2006-2015,2017-2019 +/* Copyright 1995-2004,2006-2015,2017-2020 Free Software Foundation, Inc. This file is part of Guile. @@ -452,6 +452,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name, unsigned options) "file port"); fp->fdes = fdes; fp->options = options; + fp->revealed = 0; port = scm_c_make_port (scm_file_port_type, mode_bits, (scm_t_bits)fp); diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index d2b3b0f6d..31fb2b0a8 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -2,7 +2,7 @@ ;;;; Jim Blandy --- May 1999 ;;;; ;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010, -;;;; 2011, 2012, 2013, 2014, 2015, 2017, 2019 Free Software Foundation, Inc. +;;;; 2011, 2012, 2013, 2014, 2015, 2017, 2019, 2020 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 @@ -602,10 +602,40 @@ (pass-if "unread residue" (string=? (read-line) "moon")))) +(pass-if-equal "initial revealed count" ; + 0 + (let* ((port (open-input-file "/dev/null")) + (revealed (port-revealed port))) + (close-port port) + revealed)) + +(pass-if-equal "non-revealed port is closed" + EBADF + (let* ((port (open-input-file "/dev/null")) + (fdes (fileno port))) ;leaves revealed count unchanged + (unless (zero? (port-revealed port)) + (error "wrong revealed count" (port-revealed port))) + + (set! port #f) + (gc) + (catch 'system-error + (lambda () + (seek fdes 0 SEEK_CUR) + + ;; If we get here, it might be because PORT was not GC'd, we + ;; don't know (and we can't use a guardian because it would keep + ;; PORT alive.) + (close-fdes fdes) + (throw 'unresolved)) + (lambda args + (system-error-errno args))))) + (pass-if-equal "close-port & revealed port" EBADF (let* ((port (open-file "/dev/null" "r0")) (fdes (port->fdes port))) ;increments revealed count of PORT + (unless (= 1 (port-revealed port)) + (error "wrong revealed count" (port-revealed port))) (close-port port) ;closes FDES as a side-effect (catch 'system-error (lambda () @@ -617,6 +647,9 @@ (pass-if "revealed port fdes not closed" (let* ((port (open-file "/dev/null" "r0")) (fdes (port->fdes port))) + (unless (= 1 (port-revealed port)) + (error "wrong revealed count" (port-revealed port))) + (set! port #f) (gc)