[PATCH v3] pkl,libpoke: report exception in pk{l,}_load functions

[Mohammad-Reza Nabipoor]

2023-10-06  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/libpoke.h (pk_load): Add `exit_exception' parameter.
        * libpoke/libpoke.c (pk_load): Likewise.
        * libpoke/pkl.h (pkl_load): Likewise.
        * libpoke/pkl.c (pkl_load): Likewise.
        * poke/pk-cmd.c (pk_cmd_init): Call default handler for loading
        `pk-cmd' module.
        * poke/poke.c (initialize): Update use of `pk_load'.
        * pokefmt/pokefmt.l (poke_init): Likewise.
        * testsuite/poke.libpoke/api.c (test_pk_load): New function for
        `pk_load'-related tests.
        (main): Call `test_pk_load'.
---

Hi Jose.

On Wed, Oct 04, 2023 at 11:57:25AM +0200, Jose E. Marchesi wrote:
> I wonder, wouldn't it be better to have pk_load behave like
> pk_compile_file?  I mean that the later returns PK_ERROR only in the
> eventuality of a compilation error, and then the run-time status is
> reported via exit_exception.


Yes.
Fixed.


Regards,
Mohammad-Reza


 ChangeLog                    | 14 ++++++++++++++
 libpoke/libpoke.c            |  5 +++--
 libpoke/libpoke.h            |  9 +++++++--
 libpoke/pkl.c                | 12 +++---------
 libpoke/pkl.h                | 12 +++++++++---
 poke/pk-cmd.c                |  9 +++++++--
 poke/poke.c                  | 22 +++++++++++++---------
 pokefmt/pokefmt.l            |  3 ++-
 testsuite/poke.libpoke/api.c | 21 ++++++++++++++++++++-
 9 files changed, 78 insertions(+), 29 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8aebc12c..12b8258b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2023-10-06  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/libpoke.h (pk_load): Add `exit_exception' parameter.
+       * libpoke/libpoke.c (pk_load): Likewise.
+       * libpoke/pkl.h (pkl_load): Likewise.
+       * libpoke/pkl.c (pkl_load): Likewise.
+       * poke/pk-cmd.c (pk_cmd_init): Call default handler for loading
+       `pk-cmd' module.
+       * poke/poke.c (initialize): Update use of `pk_load'.
+       * pokefmt/pokefmt.l (poke_init): Likewise.
+       * testsuite/poke.libpoke/api.c (test_pk_load): New function for
+       `pk_load'-related tests.
+       (main): Call `test_pk_load'.
+
 2023-10-06  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/libpoke.h (LIBPOKE_NONNULL): New macro for nonnull attribute
diff --git a/libpoke/libpoke.c b/libpoke/libpoke.c
index 10b4be6d..9b463cc6 100644
--- a/libpoke/libpoke.c
+++ b/libpoke/libpoke.c
@@ -232,9 +232,10 @@ pk_compile_expression (pk_compiler pkc, const char *buffer,
 }
 
 int
-pk_load (pk_compiler pkc, const char *module)
+pk_load (pk_compiler pkc, const char *module, pk_val *exit_exception)
 {
-  PK_RETURN (pkl_load (pkc->compiler, module) == 0 ? PK_ERROR : PK_OK);
+  PK_RETURN (pkl_load (pkc->compiler, module, exit_exception) == 0 ? PK_ERROR
+                                                                   : PK_OK);
 }
 
 void
diff --git a/libpoke/libpoke.h b/libpoke/libpoke.h
index 2f0b3324..e36fa48e 100644
--- a/libpoke/libpoke.h
+++ b/libpoke/libpoke.h
@@ -283,10 +283,15 @@ int pk_compile_expression_with_loc (pk_compiler pkc, 
const char *buffer,
    and all the definitions are re-defined.  This is the same behavior
    than the `load' Poke language construction.
 
-   If the module cannot be loaded, return PK_ERROR.  Otherwise,
+   EXIT_EXCEPTION is a pointer to a pk_val variable that is set to an
+   Exception value if the moudle load results in an unhandled exception,
+   PK_NULL otherwise.
+
+   Return PK_ERROR in case of a compilation error.  Otherwise,
    return PK_OK.  */
 
-int pk_load (pk_compiler pkc, const char *module) LIBPOKE_API;
+int pk_load (pk_compiler pkc, const char *module,
+             pk_val *exit_exception) LIBPOKE_API LIBPOKE_NONNULL (1, 2, 3);
 
 /* Print a disassembly of a named function.
 
diff --git a/libpoke/pkl.c b/libpoke/pkl.c
index 2b352c64..ce789212 100644
--- a/libpoke/pkl.c
+++ b/libpoke/pkl.c
@@ -765,21 +765,15 @@ pkl_resolve_module (pkl_compiler compiler,
 }
 
 int
-pkl_load (pkl_compiler compiler, const char *module)
+pkl_load (pkl_compiler compiler, const char *module, pvm_val *exit_exception)
 {
-  pvm_val exit_exception;
   char *module_filename = pkl_resolve_module (compiler,
                                               module,
                                               0 /* filename_p */);
-  if (!module_filename)
-    return 0;
 
-  if (!pkl_execute_file (compiler, module_filename,
-                         &exit_exception)
-      || exit_exception != PVM_NULL)
+  if (!module_filename)
     return 0;
-
-  return 1;
+  return pkl_execute_file (compiler, module_filename, exit_exception);
 }
 
 static pkl_ast_node
diff --git a/libpoke/pkl.h b/libpoke/pkl.h
index e90dedcb..60278eea 100644
--- a/libpoke/pkl.h
+++ b/libpoke/pkl.h
@@ -295,10 +295,16 @@ char *pkl_resolve_module (pkl_compiler compiler, const 
char *module,
                           int filename_p);
 
 /* Load a module using the given compiler.
-   If the module cannot be loaded, return 0.
-   Otherwise, return 1.  */
 
-int pkl_load (pkl_compiler compiler, const char *module);
+   If the module cannot be loaded (either compile-time error or run-time
+   exception), return 0.  Otherwise, return 1.
+
+   *EXIT_EXCEPTION is set to an exception value if the loading of the
+   MODULE gets interrupted by an unhandled exception.
+   Otherwise *EXIT_EXCEPTION is set to PK_NULL.  */
+
+int pkl_load (pkl_compiler compiler, const char *module,
+              pvm_val *exit_exception);
 
 /* Declare a variable in the global environmnt.
 
diff --git a/poke/pk-cmd.c b/poke/pk-cmd.c
index 74aaa87e..fc4d1b1b 100644
--- a/poke/pk-cmd.c
+++ b/poke/pk-cmd.c
@@ -763,6 +763,8 @@ pk_cmd_exec_script (const char *filename)
 void
 pk_cmd_init (void)
 {
+  pk_val exception;
+
   cmds_trie = pk_trie_from_cmds (dot_cmds);
   info_trie = pk_trie_from_cmds (info_cmds);
   vm_trie = pk_trie_from_cmds (vm_cmds);
@@ -777,8 +779,11 @@ pk_cmd_init (void)
   set_cmd.subcommands = set_cmds;
 
   /* Compile commands written in Poke.  */
-  if (pk_load (poke_compiler, "pk-cmd") != PK_OK)
-    pk_fatal ("unable to load the pk-cmd module");
+  if (pk_load (poke_compiler, "pk-cmd", &exception) != PK_OK)
+    {
+      poke_handle_exception (exception);
+      pk_fatal ("unable to load the pk-cmd module");
+    }
 }
 
 void
diff --git a/poke/poke.c b/poke/poke.c
index d6ecf596..e2fb326d 100644
--- a/poke/poke.c
+++ b/poke/poke.c
@@ -651,15 +651,19 @@ initialize (int argc, char *argv[])
     free (newpaths);
   }
 
-  /* The Poke hyperlinks facilities must be loaded before poke.pk and
-     the cmd subsystem.  This is done even if the hserver is
-     disabled.  */
-  if (pk_load (poke_compiler, "pk-hserver") != PK_OK)
-    pk_fatal ("unable to load the pk-hserver module");
-
-  /* Load poke.pk  */
-  if (pk_load (poke_compiler, "poke") != PK_OK)
-    pk_fatal ("unable to load the poke module");
+  {
+    pk_val exception;
+
+    /* The Poke hyperlinks facilities must be loaded before poke.pk and
+       the cmd subsystem.  This is done even if the hserver is
+       disabled.  */
+    if (pk_load (poke_compiler, "pk-hserver", &exception) != PK_OK)
+      pk_fatal ("unable to load the pk-hserver module");
+
+    /* Load poke.pk  */
+    if (pk_load (poke_compiler, "poke", &exception) != PK_OK)
+      pk_fatal ("unable to load the poke module");
+  }
 
   /* Set the values of a few global variables defined in poke.pk.  */
   {
diff --git a/pokefmt/pokefmt.l b/pokefmt/pokefmt.l
index fffda29f..891f7832 100644
--- a/pokefmt/pokefmt.l
+++ b/pokefmt/pokefmt.l
@@ -503,7 +503,8 @@ poke_init (struct poke *pk, const char *poke_src_file, FILE 
*output)
     free (user_load_path);
   }
 
-  if (pk_load (pk->compiler, "pokefmt") != PK_OK)
+  if (pk_load (pk->compiler, "pokefmt", &pexc) != PK_OK)
+    /* There's no default exception handler yet to handle `pexc'.  */
     errx (1, "pk_load() failed for pokefmt.pk");
 
   if (pk_decl_val (pk->compiler, "pokefmt_expr_printer") == PK_NULL)
diff --git a/testsuite/poke.libpoke/api.c b/testsuite/poke.libpoke/api.c
index 906998b1..805c16e7 100644
--- a/testsuite/poke.libpoke/api.c
+++ b/testsuite/poke.libpoke/api.c
@@ -117,6 +117,24 @@ test_pk_keyword_p (pk_compiler pkc)
   T ("pk_keyword_p_2", !pk_keyword_p (pkc, "foo"));
 }
 
+static void
+test_pk_load (pk_compiler pkc)
+{
+  /* An invalid value for pk_val, just to make sure pk_load is
+     modifying it.  */
+  pk_val exception = 0;
+
+  T ("pk_load_1", pk_load (pkc, "std", &exception) == PK_OK);
+  T ("pk_load_1 exception", exception == PK_NULL);
+
+  exception = 0;  /* Again resetting to an invalid value.  */
+
+  T ("pk_load_2", pk_load (pkc, "a-module_which-does_not-exist",
+                           &exception) == PK_ERROR);
+  /* Still has the invalid value.  */
+  T ("pk_load_1 exception", exception == 0);
+}
+
 int
 main ()
 {
@@ -124,8 +142,9 @@ main ()
 
   pkc = test_pk_compiler_new ();
 
-  test_pk_compiler_free (pkc);
   test_pk_keyword_p (pkc);
+  test_pk_load (pkc);
+  test_pk_compiler_free (pkc);
 
   return 0;
 }
-- 
2.42.0