ScriptFu: TinyScheme: fix closing of ports

Formerly, closing a port cleared all the attribute bits.
Then the port was not disposed of properly (leaked memory)
when the port was garbage collected.

Now, closing a port only clears the direction bits.
The kind of port is still known for a closed port.

Add test script for file port methods of Scheme.

plug-ins/script-fu/libscriptfu/tinyscheme/scheme-private.h

@@ -7,22 +7,23 @@
 /*------------------ Ugly internals -----------------------------------*/
 /*------------------ Of interest only to FFI users --------------------*/
 
-/* FIXME: should be a bit field.
- * Closing should not clear the entire field.
- * The enum or bit-field type should be referenced.
- * Subkind should be enum in, out, or in/out.
+/* FUTURE: should have bit fields.
+ * With separate enums for each field.
+ */
+/* Direction bit field:
+ *    00 fully closed
+ *    01 open for input
+ *    10 open for output
+ *    11 open for input or output
+ */
+/* !!! A struct port retains whether the port
+ * is-a string or file port, even when closed.
  */
 enum PortData {
-  /* port_free is not a bit that can be set.
-   * closing does kind=port_free which clears the entire value,
-   * losing the kind and subkind.
-   * FIXME: is_closed should be a state bit.
-   */
-  port_free=0,
   /* Kind */
   port_file=1,
   port_string=2,
-  /* Subkind */
+  /* Direction. */
   port_input=4,
   port_output=8,
   /* A state, for all kinds. */

plug-ins/script-fu/libscriptfu/tinyscheme/scheme.c

@@ -1512,9 +1512,13 @@ static void finalize_cell(scheme *sc, pointer a) {
     }
   else if(is_port(a))
     {
+      /* Scheme does not require a script to close a port.
+       * Close the file on the system and/or free memory resources.
+       */
       if(a->_object._port->kind & port_file)
         {
           if (a->_object._port->rep.stdio.closeit)
+            /* Safe to call port_close when already closed. */
             port_close(sc,a,port_input|port_output);
           sc->free(a->_object._port);
         }
@@ -1524,13 +1528,7 @@ static void finalize_cell(scheme *sc, pointer a) {
         }
       else
         {
-          /* It must have been closed.
-           * FIXME: This is leaking if a string-port was closed?
-           * Closing should not set the entire kind to zero
-           * since it loses the kind of string-port.
-           */
-          g_assert (a->_object._port->kind == port_free);
-          g_warning ("%s Did not dispose port already closed %p.", G_STRFUNC, a->_object._port);
+          g_warning ("%s Unknown port kind.", G_STRFUNC);
         }
     }
     /* Else object has no allocation. */
@@ -1637,14 +1635,29 @@ static pointer port_from_file(scheme *sc, FILE *f, int prop) {
 }
 
 
-
-static void port_close(scheme *sc, pointer p, int flag) {
+/* Close one or more directions of the port.
+ *
+ * When there are no directions remaining, the port becomes fully closed.
+ *
+ * When the port is already fully closed, this does nothing.
+ *
+ * When a port becomes fully closed, release OS resources (close the file),
+ * for a file-port. A string-port has no system resources.
+ *
+ * The port remains an object to be gc'd later
+ * but a script cannot call some port methods on the port.
+ */
+static void port_close(scheme *sc, pointer p, int directions) {
   port *pt=p->_object._port;
 
-  /* Clear the direction that is closing. */
-  pt->kind &= ~flag;
+  /* Fully closed already? */
+  if((pt->kind & (port_input|port_output))==0)
+    return;
 
-  /* If there are no directions remaining. */
+  /* Clear directions that are closing. */
+  pt->kind &= ~directions;
+
+  /* Fully closed? */
   if((pt->kind & (port_input|port_output))==0) {
     if(pt->kind&port_file) {
 
@@ -1658,8 +1671,9 @@ static void port_close(scheme *sc, pointer p, int flag) {
 
       fclose(pt->rep.stdio.file);
     }
-    /* Clear port direction, kind, and saw_EOF. */
-    pt->kind=port_free;
+    /* Closing does not lose the kind of port nor the saw_EOF flag.
+     * The port struct still has attributes, until it is destroyed.
+     */
   }
 }
 

plug-ins/script-fu/test/meson.build

@@ -88,6 +88,7 @@ if not stable
     'tests' / 'TS' / 'atom2string.scm',
     'tests' / 'TS' / 'integer2char.scm',
     'tests' / 'TS' / 'string-escape.scm',
+    'tests' / 'TS' / 'file-port.scm',
     'tests' / 'TS' / 'string-port-input.scm',
     'tests' / 'TS' / 'string-port-output.scm',
     # WIP 'tests' / 'TS' / 'string-port-unichar.scm',

plug-ins/script-fu/test/tests/TS/file-port.scm

@@ -0,0 +1,151 @@
+; Test cases for file port
+
+
+
+; setup
+; Some tests use new ports, not the setup one.
+
+
+(define aOutFilePort (open-output-file "testFile"))
+
+; Note the file is in the current working directory
+
+; Note read and write are in terms of objects,
+; so a string in the file will have quotes.
+
+
+; tests
+
+; Output port
+
+(test! "open-output-file yields a port")
+(assert `(port? ,aOutFilePort))
+
+; Note the file is overwritten if it already exists.
+
+(test! "open-output-file yields a port of kind output")
+(assert `(output-port? ,aOutFilePort))
+(test! "open-output-file yields a port NOT of kind input")
+(assert `(not (input-port? ,aOutFilePort)))
+
+(test! "write succeeds on an output file-port")
+(assert `(write "bar" ,aOutFilePort))
+
+(test! "closing a port succeeds")
+(assert `(close-port ,aOutFilePort))
+
+(test! "closing a port a second time throws an error")
+; FIXME Not tested.  The testing framework doesn't catch, and stops.
+; Note it actually is still a port, but it is not open any more.
+;(assert-error `(close-port ,aOutFilePort)
+;              "Error: not a port")
+
+; aOutFilePort is still in scope and shoud not be garbage collected.
+
+(test! "A closed port is still a port")
+(assert `(port? ,aOutFilePort))
+
+(test! "A closed port has no direction")
+(assert `(not (output-port? ,aOutFilePort)))
+(assert `(not (input-port? ,aOutFilePort)))
+
+(test! "a closed port cannot be written")
+; Note it doesn't say "must be open"
+(assert-error `(write "foo" ,aOutFilePort)
+              "write: argument 2 must be: output port")
+
+
+; Input port
+
+(test! "a closed output file port can be then opened for input")
+(define aInFilePort (open-input-file "testFile"))
+
+(test! "open-input-file yields a port of kind input")
+(assert `(input-port? ,aInFilePort))
+(test! "open-input-file yields a port NOT of kind output")
+(assert `(not (output-port? ,aInFilePort)))
+
+(test! "write always fails on an input file-port")
+(assert-error `(write "bar" ,aInFilePort)
+              "write: argument 2 must be: output port")
+(test! "write-char  always fails on an input file-port")
+(assert-error `(write-char #\a ,aInFilePort)
+              "write-char: argument 2 must be: output port")
+(test! "write-byte always fails on an input file-port")
+(assert-error `(write-byte (integer->byte 72),aInFilePort)
+              "write-byte: argument 2 must be: output port")
+
+(test! "string read from input file port equals what we wrote earlier")
+(assert `(string=?
+            (read ,aInFilePort)
+            "bar"))
+
+(test! "next read from input file port equals EOF")
+(assert `(eof-object? (read ,aInFilePort)))
+
+(test! "closing a input port")
+(assert `(close-port ,aInFilePort))
+
+
+(test! "a closed input port cannot be read")
+; Note it doesn't say "must be open"
+(assert-error `(read ,aInFilePort)
+              "read: argument 1 must be: input port")
+
+
+
+
+; input-output file port
+(define aInOutFilePort (open-input-output-file "testFile"))
+
+; Note the file is not overwritten if it already exists.
+
+(test! "open-input-output-file yields a port")
+(assert `(port? ,aInOutFilePort))
+
+(test! "open-input-output-file yields a port of kind output")
+(assert `(output-port? ,aInOutFilePort))
+(test! "open-input-output-file yields a port also of kind input")
+(assert `(input-port? ,aInOutFilePort))
+
+(test! "string read from input file port equals what we wrote earlier")
+(assert `(string=?
+            (read ,aInOutFilePort)
+            "bar"))
+
+(test! "next read from input-output file port equals EOF")
+(assert `(eof-object? (read ,aInOutFilePort)))
+
+(test! "write-char space succeeds on an input-output file-port")
+(assert `(write-char #\space ,aInOutFilePort))
+
+(test! "write succeeds on an input-output file-port")
+(assert `(write "zed" ,aInOutFilePort))
+
+; The model is NOT of independent read and write cursors.
+; See the following tests.
+
+; This fails w string-length: argument 1 must be: string (/usr/local/share/gimp/3.0/tests/file-port.scm : 107)
+;(test! "string read from input-output file port equals what we just wrote")
+; read cursor points before what we just wrote
+;(assert `(string=?
+;            (read ,aInOutFilePort)
+;            "zed"))
+
+(test! "next read from input-output file port after a write equals EOF")
+(assert `(eof-object? (read ,aInOutFilePort)))
+
+
+
+; TODO
+; close-port is generic for any port
+; close-input-port on a input-output port should only close it for read
+; and leave it open for write?
+
+; TODO port with unichar contents
+
+
+
+
+
+

plug-ins/script-fu/test/tests/TS/tinyscheme.scm

@@ -16,6 +16,8 @@
 (testing:load-test "integer2char.scm")
 
 (testing:load-test "string-escape.scm")
+
+(testing:load-test "file-port.scm")
 (testing:load-test "string-port-output.scm")
 (testing:load-test "string-port-input.scm")
 ; WIP