[COMMITTED] std: introduce with_temp_ios and with_cur_ios

[Jose E. Marchesi]

Based on partial work by apache2.

2022-04-14  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/std.pk (Pk_With_Ios_Fn): New type.
        (with_temp_ios): New function.
        * doc/poke.texi (with_temp_ios): New section.
---
 ChangeLog                      | 11 +++++
 doc/poke.texi                  | 77 +++++++++++++++++++++++++++++++++++
 libpoke/std.pk                 | 91 ++++++++++++++++++++++++++++++++++++++++++
 testsuite/poke.std/std-test.pk | 63 +++++++++++++++++++++++++++++
 4 files changed, 242 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 82dcadcc..30c49201 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2022-04-14  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/std.pk (Pk_With_Ios_Fn): New type.
+       (Pk_Temp_Ios_Generator): Likewise.
+       (with_temp_ios): New function.
+       (with_cur_ios): Likewise.
+       * testsuite/poke.std/std-test.pk: Tests for with_temp_ios and
+       with_cur_ios.
+       * doc/poke.texi (with_temp_ios): New section.
+       (with_cur_ios): Likewise.
+
 2022-04-12  Jose E. Marchesi  <jemarch@gnu.org>
 
        * pickles/openpgp.pk (PGP_Packet): Remove pretty-printer.  Use an
diff --git a/doc/poke.texi b/doc/poke.texi
index 93930eee..841fa139 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -14353,6 +14353,7 @@ facilities provided by the library.
 * Array Functions::             Functions which deal with arrays.
 * String Functions::           Functions which deal with strings.
 * Values Functions::            Functions which deal with values in general.
+* IO Space Functions::          Functions that operate on IO spaces.
 * Sorting Functions::          qsort.
 * CRC Functions::               Cyclic Redundancy Checksums.
 * Dates and Times::             Processing and displaying dates and times.
@@ -14679,6 +14680,82 @@ It returns the offset of the element having the given 
name in the
 given composite value.  If the value doesn't contain an element with
 the given name then the exception @code{E_inval} is raised.
 
+@node IO Space Functions
+@section IO Space Functions
+
+@menu
+* with_cur_ios::        Executing code on a given IO space.
+* with_temp_ios::       Executing code on a temporary IO space.
+@end menu
+
+@node with_cur_ios
+@subsection @code{with_cur_ios}
+@cindex @code{with_cur_ios}
+
+The standard function @code{with_cur_ios} provides the following
+interface:
+
+@example
+fun with_cur_ios = (int<32> @var{ios},
+                    Pk_With_Ios_Fn @var{do} = lambda void:@{@},
+                    int<32> @var{endian} = get_endian) void:
+@end example
+
+Where @var{ios} is an IO space identifier, @var{do} is a function of
+type @code{()void} that defaults to a function that does nothing, and
+@var{endian} is the endianness to use by default when accessing
+@var{ios}.
+
+When invoked it switches to the given IO space and executes the given
+function.  Once the function finishes executing, either by returning
+or by the raise of an exception, the current IO space and endianness
+are restored to their previous values.
+
+@node with_temp_ios
+@subsection @code{with_temp_ios}
+@cindex @code{with_temp_ios}
+
+The standard function @code{with_temp_ios} provides the following
+interface:
+
+@example
+fun with_temp_ios = (string @var{handler} = pk_get_unique_mem_ios_handler,
+                     uint<32> @var{flags} = 0,
+                     Pk_With_Ios_Fn @var{do} = lambda void:@{@},
+                     int<32> @var{endian} = get_endian) void:
+@end example
+
+Where @var{handler} is the handler to use for the IO space.
+
+@var{flags} are the flags passed to @code{open} when opening the
+temporary IO space.  Defaults to 0, which means to use whatever
+opening mode makes more sense depending on the kind of the IO space
+and it's permissions.
+
+@var{do} is a function of type @code{()void}.  Defaults to a function
+that does nothing.
+
+@var{endian} is the endianness to use by default when accessing the
+temporary IO space.  Defaults to the current endianness.
+
+When invoked it opens a IO space, like @code{openset}, but takes care
+of calling @code{close} and restoring the original current IO space
+and endianness after the lambda returns or raises an exception.
+
+It can be used to deal with files without risk of leaking file
+descriptors.
+
+@example
+with_cur_ios
+  :handler "*buf*"
+  :do lambda void:
+  @{
+    var arr = uint<32>[1] @ 0#B;
+    arr[0] = 0x1234;
+    printf("%v", byte[4] @ 0#b);
+  @}
+@end example
+
 @node Sorting Functions
 @section Sorting Functions
 @cindex sorting
diff --git a/libpoke/std.pk b/libpoke/std.pk
index df70be27..e7cb8ef0 100644
--- a/libpoke/std.pk
+++ b/libpoke/std.pk
@@ -403,3 +403,94 @@ fun eoffset = (any v, string n) offset<uint<64>,b>:
         return v'eoffset (i);
     raise E_inval;
   }
+
+/* Generator of uniquely-named memory IO handlers.  */
+
+type Pk_Temp_Ios_Generator = ()string;
+
+var pk_get_unique_mem_ios_handler = lambda Pk_Temp_Ios_Generator:
+{
+  var n = 0;
+  return lambda string: { return format ("*tmp%u32d*", n++); };
+} ();
+
+/* Open a temporary IO space, set it as current, and execute a given
+   function.
+
+   HANDLER is the handler to use for the IO space.
+
+   FLAGS are the flags passed to `open' when opening the temporary IO
+   space.  Defaults to 0, which means to use whatever opening mode
+   makes more sense depending on the kind of the IO space and it's
+   permissions.
+
+   DO is a function of type ()void.  Defaults to a function that does
+   nothing.
+
+   ENDIAN is the endianness to use by default when accessing the
+   temporary IO space.  Defaults to the current endianness.
+
+   Note that once `with_temp_ios' finishes executing, either by
+   returning or by the raise of an exception, the temporary IO space
+   is closed and the original current endianness is restored.  */
+
+type Pk_With_Ios_Fn = ()void;
+
+fun with_temp_ios = (string handler = pk_get_unique_mem_ios_handler,
+                     uint<32> flags = 0,
+                     Pk_With_Ios_Fn do = lambda void:{},
+                     int<32> endian = get_endian) void:
+{
+  var old_ios = get_ios ?! E_no_ios ? get_ios : -1;
+  var old_endian = get_endian;
+  var new_ios = open (handler, flags);
+
+  set_ios (new_ios);
+  set_endian (endian);
+  try
+  {
+    do ();
+    close (new_ios);
+    set_endian (old_endian);
+    if (-1 != old_ios)
+      set_ios (old_ios);
+  }
+  catch (Exception exc)
+  {
+    close (new_ios);
+    set_endian (old_endian);
+    if (-1 != old_ios)
+      set_ios (old_ios);
+    raise exc;
+  }
+}
+
+/* Set a given IO space as current and execute a given function.  Once
+   the function finishes executing, either by returning or by the
+   raise of an exception, the current IO space and endianness are
+   restored to their previous values.  */
+
+fun with_cur_ios = (int<32> ios,
+                    Pk_With_Ios_Fn do = lambda void:{},
+                    int<32> endian = get_endian) void:
+{
+  var old_ios = get_ios ?! E_no_ios ? get_ios : -1;
+  var old_endian = get_endian;
+
+  set_ios (ios);
+  set_endian (endian);
+  try
+  {
+    do ();
+    set_endian (old_endian);
+    if (-1 != old_ios)
+      set_ios (old_ios);
+  }
+  catch (Exception exc)
+  {
+    set_endian (old_endian);
+    if (-1 != old_ios)
+      set_ios (old_ios);
+    raise exc;
+  }
+}
diff --git a/testsuite/poke.std/std-test.pk b/testsuite/poke.std/std-test.pk
index 2915b2da..1a45fd6a 100644
--- a/testsuite/poke.std/std-test.pk
+++ b/testsuite/poke.std/std-test.pk
@@ -181,6 +181,69 @@ var tests = [
       },
   },
   PkTest {
+    name = "with_cur_ios",
+    func = lambda (string name) void:
+    {
+      var end = get_endian;
+      var ios1 = open ("*foo*"),
+          ios2 = open ("*bar*");
+
+      set_ios (ios2);
+      with_cur_ios :ios ios1
+                   :endian !end
+                   :do lambda void: { int<32> @ 11#B = 0xdeadbeef; };
+      assert (get_ios == ios2);
+      assert ((byte @ ios1 : 11#B) == (!end == ENDIAN_BIG ? 0xde : 0xef));
+      assert ((byte @ ios1 : 12#B) == (!end == ENDIAN_BIG ? 0xad : 0xbe));
+      close (ios2);
+      close (ios1);
+    }
+  },
+  PkTest {
+    name = "with_temp_ios",
+    func = lambda (string name) void:
+      {
+        var a = 10;
+        var end = get_endian;
+
+        /* First, simple test with no opened IO space.  */
+        with_temp_ios :handler "*bar*"
+                      :endian !end
+                      :do lambda void: { a = int<32> @ 0#B; };
+        assert (!(get_ios ?! E_no_ios));
+        assert (a == 0);
+
+        /* No arguments.  */
+        with_temp_ios;
+        assert (!(get_ios ?! E_no_ios));
+
+        /* Now with an already opened IO space.  */
+        var ios = open ("*foo*");
+        with_temp_ios :handler "*bar*"
+                      :endian !end
+                      :do lambda void: { byte @ 0#B = 0xab;
+                                         byte @ 1#B = 0xcd;
+                                         a = int<32> @ 0#B; };
+        assert (get_ios == ios);
+        assert (get_endian == end);
+        assert (!end == ENDIAN_BIG ? a == 0xabcd : a == 0xcdab);
+
+        /* Now with an exception return.  */
+        try with_temp_ios :handler "*bar*"
+                          :endian !end
+                          :do lambda void: { byte @ 0#B = 0xbe;
+                                             byte @ 1#B = 0xef;
+                                             a = int<32> @ 0#B;
+                                             raise E_inval; };
+        catch if E_inval {};
+
+        assert (get_ios == ios);
+        assert (get_endian == end);
+        assert (!end == ENDIAN_BIG ? a == 0xbeef : a == 0xefbe);
+        close (ios);
+      },
+  },
+  PkTest {
     name = "qsort",
     func = lambda (string name) void:
       {
-- 
2.11.0