bug#30373: Support finalizers for functions created in dynamic modules

bug#30373: Support finalizers for functions created in dynamic modules

[Samir Jindel]

[-- Attachment #1: Type: text/plain, Size: 1107 bytes --]

Hi,

I'm very excited by the possibilities opened through the new dynamic module
interface, "emacs-module.h".

However, I have a concern about the API for creating Lisp functions bound
to native functions:

```c

  emacs_value (*make_function) (emacs_env *env,
        ptrdiff_t min_arity,
        ptrdiff_t max_arity,
        emacs_value (*function) (emacs_env *env,
               ptrdiff_t nargs,
               emacs_value args[],
               void *)
          EMACS_NOEXCEPT,
        const char *documentation,
        void *data);

```

I presume the "data" pointer here is provided to enable native functions to
work like closures,
carrying additional, possibly dynamically allocated data. However, this
functionality is limited by
the absence of a finalization function pointer, like the "user_ptr" values
have:

```c

  emacs_value (*make_user_ptr) (emacs_env *env,
        void (*fin) (void *) EMACS_NOEXCEPT,
        void *ptr);

```

Without the ability to provide a finalizer, a module can only safely make
the "data" pointer to
"make_function" point to static memory.

Thanks,
Samir Jindel

[-- Attachment #2: Type: text/html, Size: 3780 bytes --]

bug#30373: Support finalizers for functions created in dynamic modules

[Philipp Stephani]

Am Di., 6. Feb. 2018 um 22:43 Uhr schrieb Samir Jindel <sjindel@google.com>:
>
> Hi,
>
> I'm very excited by the possibilities opened through the new dynamic module interface, "emacs-module.h".
>
> However, I have a concern about the API for creating Lisp functions bound to native functions:
>
> ```c
>
>   emacs_value (*make_function) (emacs_env *env,
>         ptrdiff_t min_arity,
>         ptrdiff_t max_arity,
>         emacs_value (*function) (emacs_env *env,
>                ptrdiff_t nargs,
>                emacs_value args[],
>                void *)
>           EMACS_NOEXCEPT,
>         const char *documentation,
>         void *data);
>
> ```
>
> I presume the "data" pointer here is provided to enable native functions to work like closures,
> carrying additional, possibly dynamically allocated data. However, this functionality is limited by
> the absence of a finalization function pointer, like the "user_ptr" values have:
>
> ```c
>
>   emacs_value (*make_user_ptr) (emacs_env *env,
>         void (*fin) (void *) EMACS_NOEXCEPT,
>         void *ptr);
>
> ```
>
> Without the ability to provide a finalizer, a module can only safely make the "data" pointer to
> "make_function" point to static memory.
>

Sorry for not responding for so long. I think this makes a lot of
sense, and we should definitely introduce function finalizers.
I can think of three possible interface choices for this:
1. Add a make_finalizable_function environment function that is like
make_function but accepts a finalizer.
2. Add a set_function_finalizer(env, emacs_value, void(*)(void))
environment function.
3. Allow set_user_finalizer to also set function finalizers.
I'd lean away from (1) since it makes an already complex interface
even more complex. (2) seems cleanest, but requires adding a new
environment function. (3) would require the least amount of changes,
but it would also be slightly less clean than (2), and would break
backwards compatibility in a subtle way (users relying on
set_user_finalizer raising an error if a non-user-pointer object is
passed would break). Overall, I'd slightly lean towards (2).
Other opinions?

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Philipp Stephani]

* src/module-env-28.h: Add new module environment functions to
module environment for Emacs 28.

* src/emacs-module.c (CHECK_MODULE_FUNCTION): New function.
(struct Lisp_Module_Function): Add finalizer data member.
(module_make_function): Initialize finalizer.
(module_get_function_finalizer)
(module_set_function_finalizer): New module environment functions.
(module_finalize_function): New function.
(initialize_environment): Initialize new environment functions.

* src/alloc.c (cleanup_vector): Call potential module function
finalizer during garbage collection.

* test/data/emacs-module/mod-test.c (signal_error): New helper
function.
(memory_full): Use it.
(finalizer): New example function finalizer.
(Fmod_test_make_function_with_finalizer)
(Fmod_test_function_finalizer_calls): New test module functions.
(emacs_module_init): Define them.

* test/src/emacs-module-tests.el (module/function-finalizer): New unit
test.
---
 src/alloc.c                       |  6 ++++
 src/emacs-module.c                | 45 +++++++++++++++++++++++++---
 src/lisp.h                        |  1 +
 src/module-env-28.h               |  8 +++++
 test/data/emacs-module/mod-test.c | 49 +++++++++++++++++++++++++++++--
 test/src/emacs-module-tests.el    |  8 +++++
 6 files changed, 111 insertions(+), 6 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 6a17bedc75..94c1433124 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3023,6 +3023,12 @@ cleanup_vector (struct Lisp_Vector *vector)
       if (uptr->finalizer)
 	uptr->finalizer (uptr->p);
     }
+  else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
+    {
+      ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
+        = (struct Lisp_Module_Function *) vector;
+      module_finalize_function (function);
+    }
 }
 
 /* Reclaim space used by unmarked vectors.  */
diff --git a/src/emacs-module.c b/src/emacs-module.c
index ff1a05450c..9ec25d57af 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -122,10 +122,11 @@ Copyright (C) 2015-2019 Free Software Foundation, Inc.
 /* Function prototype for the module init function.  */
 typedef int (*emacs_init_function) (struct emacs_runtime *);
 
-/* Function prototype for module user-pointer finalizers.  These
-   should not throw C++ exceptions, so emacs-module.h declares the
-   corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
-   in this module, though, so this constraint is not enforced here.  */
+/* Function prototype for module user-pointer and function finalizers.
+   These should not throw C++ exceptions, so emacs-module.h declares
+   the corresponding interfaces with EMACS_NOEXCEPT.  There is only C
+   code in this module, though, so this constraint is not enforced
+   here.  */
 typedef void (*emacs_finalizer) (void *);
 
 \f
@@ -332,6 +333,12 @@ #define MODULE_FUNCTION_BEGIN(error_retval)      \
   MODULE_FUNCTION_BEGIN_NO_CATCH (error_retval); \
   MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
 
+static void
+CHECK_MODULE_FUNCTION (Lisp_Object obj)
+{
+  CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj);
+}
+
 static void
 CHECK_USER_PTR (Lisp_Object obj)
 {
@@ -488,6 +495,7 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
   ptrdiff_t min_arity, max_arity;
   emacs_subr subr;
   void *data;
+  emacs_finalizer finalizer;
 } GCALIGNED_STRUCT;
 
 static struct Lisp_Module_Function *
@@ -521,6 +529,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
   function->max_arity = max_arity;
   function->subr = func;
   function->data = data;
+  function->finalizer = NULL;
 
   if (docstring)
     function->documentation = build_string_from_utf8 (docstring);
@@ -532,6 +541,32 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
   return lisp_to_value (env, result);
 }
 
+static emacs_finalizer
+module_get_function_finalizer (emacs_env *env, emacs_value arg)
+{
+  MODULE_FUNCTION_BEGIN (NULL);
+  Lisp_Object lisp = value_to_lisp (arg);
+  CHECK_MODULE_FUNCTION (lisp);
+  return XMODULE_FUNCTION (lisp)->finalizer;
+}
+
+static void
+module_set_function_finalizer (emacs_env *env, emacs_value arg,
+                               emacs_finalizer fin)
+{
+  MODULE_FUNCTION_BEGIN ();
+  Lisp_Object lisp = value_to_lisp (arg);
+  CHECK_MODULE_FUNCTION (lisp);
+  XMODULE_FUNCTION (lisp)->finalizer = fin;
+}
+
+void
+module_finalize_function (const struct Lisp_Module_Function *func)
+{
+  if (func->finalizer != NULL)
+    func->finalizer (func->data);
+}
+
 static emacs_value
 module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
 		emacs_value *args)
@@ -1339,6 +1374,8 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
   env->make_time = module_make_time;
   env->extract_big_integer = module_extract_big_integer;
   env->make_big_integer = module_make_big_integer;
+  env->get_function_finalizer = module_get_function_finalizer;
+  env->set_function_finalizer = module_set_function_finalizer;
   Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
   return env;
 }
diff --git a/src/lisp.h b/src/lisp.h
index e0ae2c4262..1bd78284d7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4245,6 +4245,7 @@ XMODULE_FUNCTION (Lisp_Object o)
   (struct Lisp_Module_Function const *);
 extern module_funcptr module_function_address
   (struct Lisp_Module_Function const *);
+extern void module_finalize_function (const struct Lisp_Module_Function *);
 extern void mark_modules (void);
 extern void init_module_assertions (bool);
 extern void syms_of_module (void);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index dec8704edd..a2479a8f74 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -1,3 +1,11 @@
   /* Add module environment functions newly added in Emacs 28 here.
      Before Emacs 28 is released, remove this comment and start
      module-env-29.h on the master branch.  */
+
+  void (*(*EMACS_ATTRIBUTE_NONNULL (1)
+            get_function_finalizer) (emacs_env *env,
+                                     emacs_value arg)) (void *) EMACS_NOEXCEPT;
+
+  void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
+                                  void (*fin) (void *) EMACS_NOEXCEPT)
+    EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 5addf61147..6a70a7ab57 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -373,15 +373,20 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
 }
 
 static void
-memory_full (emacs_env *env)
+signal_error (emacs_env *env, const char *message)
 {
-  const char *message = "Memory exhausted";
   emacs_value data = env->make_string (env, message, strlen (message));
   env->non_local_exit_signal (env, env->intern (env, "error"),
                               env->funcall (env, env->intern (env, "list"), 1,
                                             &data));
 }
 
+static void
+memory_full (emacs_env *env)
+{
+  signal_error (env, "Memory exhausted");
+}
+
 enum
 {
   max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX)
@@ -490,6 +495,42 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
   return result;
 }
 
+static int function_data;
+static int finalizer_calls_with_correct_data;
+static int finalizer_calls_with_incorrect_data;
+
+static void
+finalizer (void *data)
+{
+  if (data == &function_data)
+    ++finalizer_calls_with_correct_data;
+  else
+    ++finalizer_calls_with_incorrect_data;
+}
+
+static emacs_value
+Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs,
+                                        emacs_value *args, void *data)
+{
+  emacs_value fun
+    = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data);
+  env->set_function_finalizer (env, fun, finalizer);
+  if (env->get_function_finalizer (env, fun) != finalizer)
+    signal_error (env, "Invalid finalizer");
+  return fun;
+}
+
+static emacs_value
+Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
+                                    emacs_value *args, void *data)
+{
+  emacs_value Flist = env->intern (env, "list");
+  emacs_value list_args[]
+    = {env->make_integer (env, finalizer_calls_with_correct_data),
+       env->make_integer (env, finalizer_calls_with_incorrect_data)};
+  return env->funcall (env, Flist, 2, list_args);
+}
+
 /* Lisp utilities for easier readability (simple wrappers).  */
 
 /* Provide FEATURE to Emacs.  */
@@ -566,6 +607,10 @@ #define DEFUN(lsym, csym, amin, amax, doc, data) \
   DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL);
   DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL);
   DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL);
+  DEFUN ("mod-test-make-function-with-finalizer",
+         Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
+  DEFUN ("mod-test-function-finalizer-calls",
+         Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 322500ff60..d9a57aecf6 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -402,4 +402,12 @@ module-darwin-secondary-suffix
         (load so nil nil :nosuffix :must-suffix)
       (delete-file so))))
 
+(ert-deftest module/function-finalizer ()
+  (mod-test-make-function-with-finalizer)
+  (let* ((previous-calls (mod-test-function-finalizer-calls))
+         (expected-calls (copy-sequence previous-calls)))
+    (cl-incf (car expected-calls))
+    (garbage-collect)
+    (should (equal (mod-test-function-finalizer-calls) expected-calls))))
+
 ;;; emacs-module-tests.el ends here
-- 
2.21.0 (Apple Git-122.2)

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Philipp Stephani]

Since there were no objections, I've installed this patch (plus some
documentation) as commit 48ffef5ef4 into master.

Am Do., 26. Dez. 2019 um 01:05 Uhr schrieb Philipp Stephani
<p.stephani2@gmail.com>:
>
> * src/module-env-28.h: Add new module environment functions to
> module environment for Emacs 28.
>
> * src/emacs-module.c (CHECK_MODULE_FUNCTION): New function.
> (struct Lisp_Module_Function): Add finalizer data member.
> (module_make_function): Initialize finalizer.
> (module_get_function_finalizer)
> (module_set_function_finalizer): New module environment functions.
> (module_finalize_function): New function.
> (initialize_environment): Initialize new environment functions.
>
> * src/alloc.c (cleanup_vector): Call potential module function
> finalizer during garbage collection.
>
> * test/data/emacs-module/mod-test.c (signal_error): New helper
> function.
> (memory_full): Use it.
> (finalizer): New example function finalizer.
> (Fmod_test_make_function_with_finalizer)
> (Fmod_test_function_finalizer_calls): New test module functions.
> (emacs_module_init): Define them.
>
> * test/src/emacs-module-tests.el (module/function-finalizer): New unit
> test.
> ---
>  src/alloc.c                       |  6 ++++
>  src/emacs-module.c                | 45 +++++++++++++++++++++++++---
>  src/lisp.h                        |  1 +
>  src/module-env-28.h               |  8 +++++
>  test/data/emacs-module/mod-test.c | 49 +++++++++++++++++++++++++++++--
>  test/src/emacs-module-tests.el    |  8 +++++
>  6 files changed, 111 insertions(+), 6 deletions(-)
>
> diff --git a/src/alloc.c b/src/alloc.c
> index 6a17bedc75..94c1433124 100644
> --- a/src/alloc.c
> +++ b/src/alloc.c
> @@ -3023,6 +3023,12 @@ cleanup_vector (struct Lisp_Vector *vector)
>        if (uptr->finalizer)
>         uptr->finalizer (uptr->p);
>      }
> +  else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
> +    {
> +      ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
> +        = (struct Lisp_Module_Function *) vector;
> +      module_finalize_function (function);
> +    }
>  }
>
>  /* Reclaim space used by unmarked vectors.  */
> diff --git a/src/emacs-module.c b/src/emacs-module.c
> index ff1a05450c..9ec25d57af 100644
> --- a/src/emacs-module.c
> +++ b/src/emacs-module.c
> @@ -122,10 +122,11 @@ Copyright (C) 2015-2019 Free Software Foundation, Inc.
>  /* Function prototype for the module init function.  */
>  typedef int (*emacs_init_function) (struct emacs_runtime *);
>
> -/* Function prototype for module user-pointer finalizers.  These
> -   should not throw C++ exceptions, so emacs-module.h declares the
> -   corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
> -   in this module, though, so this constraint is not enforced here.  */
> +/* Function prototype for module user-pointer and function finalizers.
> +   These should not throw C++ exceptions, so emacs-module.h declares
> +   the corresponding interfaces with EMACS_NOEXCEPT.  There is only C
> +   code in this module, though, so this constraint is not enforced
> +   here.  */
>  typedef void (*emacs_finalizer) (void *);
>
>
> @@ -332,6 +333,12 @@ #define MODULE_FUNCTION_BEGIN(error_retval)      \
>    MODULE_FUNCTION_BEGIN_NO_CATCH (error_retval); \
>    MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
>
> +static void
> +CHECK_MODULE_FUNCTION (Lisp_Object obj)
> +{
> +  CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj);
> +}
> +
>  static void
>  CHECK_USER_PTR (Lisp_Object obj)
>  {
> @@ -488,6 +495,7 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
>    ptrdiff_t min_arity, max_arity;
>    emacs_subr subr;
>    void *data;
> +  emacs_finalizer finalizer;
>  } GCALIGNED_STRUCT;
>
>  static struct Lisp_Module_Function *
> @@ -521,6 +529,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
>    function->max_arity = max_arity;
>    function->subr = func;
>    function->data = data;
> +  function->finalizer = NULL;
>
>    if (docstring)
>      function->documentation = build_string_from_utf8 (docstring);
> @@ -532,6 +541,32 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
>    return lisp_to_value (env, result);
>  }
>
> +static emacs_finalizer
> +module_get_function_finalizer (emacs_env *env, emacs_value arg)
> +{
> +  MODULE_FUNCTION_BEGIN (NULL);
> +  Lisp_Object lisp = value_to_lisp (arg);
> +  CHECK_MODULE_FUNCTION (lisp);
> +  return XMODULE_FUNCTION (lisp)->finalizer;
> +}
> +
> +static void
> +module_set_function_finalizer (emacs_env *env, emacs_value arg,
> +                               emacs_finalizer fin)
> +{
> +  MODULE_FUNCTION_BEGIN ();
> +  Lisp_Object lisp = value_to_lisp (arg);
> +  CHECK_MODULE_FUNCTION (lisp);
> +  XMODULE_FUNCTION (lisp)->finalizer = fin;
> +}
> +
> +void
> +module_finalize_function (const struct Lisp_Module_Function *func)
> +{
> +  if (func->finalizer != NULL)
> +    func->finalizer (func->data);
> +}
> +
>  static emacs_value
>  module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
>                 emacs_value *args)
> @@ -1339,6 +1374,8 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
>    env->make_time = module_make_time;
>    env->extract_big_integer = module_extract_big_integer;
>    env->make_big_integer = module_make_big_integer;
> +  env->get_function_finalizer = module_get_function_finalizer;
> +  env->set_function_finalizer = module_set_function_finalizer;
>    Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
>    return env;
>  }
> diff --git a/src/lisp.h b/src/lisp.h
> index e0ae2c4262..1bd78284d7 100644
> --- a/src/lisp.h
> +++ b/src/lisp.h
> @@ -4245,6 +4245,7 @@ XMODULE_FUNCTION (Lisp_Object o)
>    (struct Lisp_Module_Function const *);
>  extern module_funcptr module_function_address
>    (struct Lisp_Module_Function const *);
> +extern void module_finalize_function (const struct Lisp_Module_Function *);
>  extern void mark_modules (void);
>  extern void init_module_assertions (bool);
>  extern void syms_of_module (void);
> diff --git a/src/module-env-28.h b/src/module-env-28.h
> index dec8704edd..a2479a8f74 100644
> --- a/src/module-env-28.h
> +++ b/src/module-env-28.h
> @@ -1,3 +1,11 @@
>    /* Add module environment functions newly added in Emacs 28 here.
>       Before Emacs 28 is released, remove this comment and start
>       module-env-29.h on the master branch.  */
> +
> +  void (*(*EMACS_ATTRIBUTE_NONNULL (1)
> +            get_function_finalizer) (emacs_env *env,
> +                                     emacs_value arg)) (void *) EMACS_NOEXCEPT;
> +
> +  void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
> +                                  void (*fin) (void *) EMACS_NOEXCEPT)
> +    EMACS_ATTRIBUTE_NONNULL (1);
> diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
> index 5addf61147..6a70a7ab57 100644
> --- a/test/data/emacs-module/mod-test.c
> +++ b/test/data/emacs-module/mod-test.c
> @@ -373,15 +373,20 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
>  }
>
>  static void
> -memory_full (emacs_env *env)
> +signal_error (emacs_env *env, const char *message)
>  {
> -  const char *message = "Memory exhausted";
>    emacs_value data = env->make_string (env, message, strlen (message));
>    env->non_local_exit_signal (env, env->intern (env, "error"),
>                                env->funcall (env, env->intern (env, "list"), 1,
>                                              &data));
>  }
>
> +static void
> +memory_full (emacs_env *env)
> +{
> +  signal_error (env, "Memory exhausted");
> +}
> +
>  enum
>  {
>    max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX)
> @@ -490,6 +495,42 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
>    return result;
>  }
>
> +static int function_data;
> +static int finalizer_calls_with_correct_data;
> +static int finalizer_calls_with_incorrect_data;
> +
> +static void
> +finalizer (void *data)
> +{
> +  if (data == &function_data)
> +    ++finalizer_calls_with_correct_data;
> +  else
> +    ++finalizer_calls_with_incorrect_data;
> +}
> +
> +static emacs_value
> +Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs,
> +                                        emacs_value *args, void *data)
> +{
> +  emacs_value fun
> +    = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data);
> +  env->set_function_finalizer (env, fun, finalizer);
> +  if (env->get_function_finalizer (env, fun) != finalizer)
> +    signal_error (env, "Invalid finalizer");
> +  return fun;
> +}
> +
> +static emacs_value
> +Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
> +                                    emacs_value *args, void *data)
> +{
> +  emacs_value Flist = env->intern (env, "list");
> +  emacs_value list_args[]
> +    = {env->make_integer (env, finalizer_calls_with_correct_data),
> +       env->make_integer (env, finalizer_calls_with_incorrect_data)};
> +  return env->funcall (env, Flist, 2, list_args);
> +}
> +
>  /* Lisp utilities for easier readability (simple wrappers).  */
>
>  /* Provide FEATURE to Emacs.  */
> @@ -566,6 +607,10 @@ #define DEFUN(lsym, csym, amin, amax, doc, data) \
>    DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL);
>    DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL);
>    DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL);
> +  DEFUN ("mod-test-make-function-with-finalizer",
> +         Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
> +  DEFUN ("mod-test-function-finalizer-calls",
> +         Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
>
>  #undef DEFUN
>
> diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
> index 322500ff60..d9a57aecf6 100644
> --- a/test/src/emacs-module-tests.el
> +++ b/test/src/emacs-module-tests.el
> @@ -402,4 +402,12 @@ module-darwin-secondary-suffix
>          (load so nil nil :nosuffix :must-suffix)
>        (delete-file so))))
>
> +(ert-deftest module/function-finalizer ()
> +  (mod-test-make-function-with-finalizer)
> +  (let* ((previous-calls (mod-test-function-finalizer-calls))
> +         (expected-calls (copy-sequence previous-calls)))
> +    (cl-incf (car expected-calls))
> +    (garbage-collect)
> +    (should (equal (mod-test-function-finalizer-calls) expected-calls))))
> +
>  ;;; emacs-module-tests.el ends here
> --
> 2.21.0 (Apple Git-122.2)
>
>
>
>

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Eli Zaretskii]

> From: Philipp Stephani <p.stephani2@gmail.com>
> Date: Fri, 3 Jan 2020 19:34:51 +0100
> Cc: Philipp Stephani <phst@google.com>
> 
> Since there were no objections, I've installed this patch (plus some
> documentation) as commit 48ffef5ef4 into master.

Thanks.

The new test fails for me on MS-Windows:

  Test module/function-finalizer backtrace:
    signal(ert-test-failed (((should (equal (mod-test-function-finalizer
    ert-fail(((should (equal (mod-test-function-finalizer-calls) expecte
    (if (unwind-protect (setq value-370 (apply fn-368 args-369)) (setq f
    (let (form-description-372) (if (unwind-protect (setq value-370 (app
    (let ((value-370 'ert-form-evaluation-aborted-371)) (let (form-descr
    (let* ((fn-368 #'equal) (args-369 (condition-case err (let ((signal-
    (let* ((previous-calls (mod-test-function-finalizer-calls)) (expecte
    (closure (t) nil (mod-test-make-function-with-finalizer) (let* ((pre
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name module/function-finalizer :documentat
    ert-run-or-rerun-test(#s(ert--stats :selector ... :tests ... :test-m
    ert-run-tests((not (tag :unstable)) #f(compiled-function (event-type
    ert-run-tests-batch((not (tag :unstable)))
    ert-run-tests-batch-and-exit((not (tag :unstable)))
    eval((ert-run-tests-batch-and-exit '(not (tag :unstable))) t)
    command-line-1((#("-L" 0 2 (charset cp862)) #(";." 0 2 (charset cp86
    command-line()
    normal-top-level()
  Test module/function-finalizer condition:
      (ert-test-failed
       ((should
	 (equal
	  (mod-test-function-finalizer-calls)
	  expected-calls))
	:form
	(equal
	 (0 0)
	 (1 0))
	:value nil :explanation
	(list-elt 0
		  (different-atoms
		   (0 "#x0" "?

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Pip Cet]

On Fri, Jan 3, 2020 at 6:45 PM Eli Zaretskii <eliz@gnu.org> wrote:
> The new test fails for me on MS-Windows:
>
>   Test module/function-finalizer backtrace:
>     signal(ert-test-failed (((should (equal (mod-test-function-finalizer
>     ert-fail(((should (equal (mod-test-function-finalizer-calls) expecte
>     (if (unwind-protect (setq value-370 (apply fn-368 args-369)) (setq f
>     (let (form-description-372) (if (unwind-protect (setq value-370 (app
>     (let ((value-370 'ert-form-evaluation-aborted-371)) (let (form-descr
>     (let* ((fn-368 #'equal) (args-369 (condition-case err (let ((signal-
>     (let* ((previous-calls (mod-test-function-finalizer-calls)) (expecte
>     (closure (t) nil (mod-test-make-function-with-finalizer) (let* ((pre
>     ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
>     ert-run-test(#s(ert-test :name module/function-finalizer :documentat
>     ert-run-or-rerun-test(#s(ert--stats :selector ... :tests ... :test-m
>     ert-run-tests((not (tag :unstable)) #f(compiled-function (event-type
>     ert-run-tests-batch((not (tag :unstable)))
>     ert-run-tests-batch-and-exit((not (tag :unstable)))
>     eval((ert-run-tests-batch-and-exit '(not (tag :unstable))) t)
>     command-line-1((#("-L" 0 2 (charset cp862)) #(";." 0 2 (charset cp86
>     command-line()
>     normal-top-level()
>   Test module/function-finalizer condition:
>       (ert-test-failed
>        ((should
>          (equal
>           (mod-test-function-finalizer-calls)
>           expected-calls))
>         :form
>         (equal
>          (0 0)
>          (1 0))
>         :value nil :explanation
>         (list-elt 0
>                   (different-atoms
>                    (0 "#x0" "? ")
>                    (1 "#x1" "? ")))))
>      FAILED  26/27  module/function-finalizer (0.109375 sec)

If I'm reading the test correctly, it depends on garbage-collect
actually collecting an unreferenced vector; since our GC's
conservative, that might not be working for you, if a word that
happens to look like a reference to the vector is still on the stack.
(Or it might be something else entirely, but I don't think the test as
it stands is correct).

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Eli Zaretskii]

> From: Pip Cet <pipcet@gmail.com>
> Date: Fri, 3 Jan 2020 18:53:46 +0000
> Cc: Philipp Stephani <p.stephani2@gmail.com>, 30373@debbugs.gnu.org, sjindel@google.com
> 
> If I'm reading the test correctly, it depends on garbage-collect
> actually collecting an unreferenced vector; since our GC's
> conservative, that might not be working for you, if a word that
> happens to look like a reference to the vector is still on the stack.
> (Or it might be something else entirely, but I don't think the test as
> it stands is correct).

You are probably right, because I see the same failure on GNU/Linux,
in an x86_64 unoptimized build:

  Test module/function-finalizer condition:
      (ert-test-failed
       ((should
	 (equal
	  (mod-test-function-finalizer-calls)
	  expected-calls))
	:form
	(equal
	 (0 0)
	 (1 0))
	:value nil :explanation
	(list-elt 0
		  (different-atoms
		   (0 "#x0" "?")
		   (1 "#x1" "?")))))
     FAILED  26/27  module/function-finalizer (0.247565 sec)

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Pip Cet]

[-- Attachment #1: Type: text/plain, Size: 984 bytes --]

On Fri, Jan 3, 2020 at 8:13 PM Eli Zaretskii <eliz@gnu.org> wrote:
> > From: Pip Cet <pipcet@gmail.com>
> > Date: Fri, 3 Jan 2020 18:53:46 +0000
> > Cc: Philipp Stephani <p.stephani2@gmail.com>, 30373@debbugs.gnu.org, sjindel@google.com
> >
> > If I'm reading the test correctly, it depends on garbage-collect
> > actually collecting an unreferenced vector; since our GC's
> > conservative, that might not be working for you, if a word that
> > happens to look like a reference to the vector is still on the stack.
> > (Or it might be something else entirely, but I don't think the test as
> > it stands is correct).
>
> You are probably right, because I see the same failure on GNU/Linux,
> in an x86_64 unoptimized build:

I see it too. Fprogn keeps the value of the first sub-form alive while
evaluating the second one.

We can "fix" Fprogn to discard val early in unoptimized builds, and
that might make GC behavior slightly less surprising.

But it won't properly fix this test.

[-- Attachment #2: 0001-Make-progn-make-huge-vector-garbage-collect-behave-a.patch --]
[-- Type: text/x-patch, Size: 652 bytes --]

From 2c15533cccbcd1622db73362195e86f9c34531e6 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Fri, 3 Jan 2020 20:47:50 +0000
Subject: [PATCH] Make (progn (make-huge-vector) (garbage-collect)) behave as
 expected

---
 src/eval.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/eval.c b/src/eval.c
index 66752a397c..eb9018f66a 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -457,6 +457,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
 
   while (CONSP (body))
     {
+      /* Don't keep VAL alive unnecessarily (bug#30373).  */
       val = Qnil;
       Lisp_Object form = XCAR (body);
       body = XCDR (body);
-- 
2.24.0

bug#30373: [PATCH] Implement finalizers for module functions (Bug#30373)

[Philipp Stephani]

Am Fr., 3. Jan. 2020 um 21:50 Uhr schrieb Pip Cet <pipcet@gmail.com>:
>
> On Fri, Jan 3, 2020 at 8:13 PM Eli Zaretskii <eliz@gnu.org> wrote:
> > > From: Pip Cet <pipcet@gmail.com>
> > > Date: Fri, 3 Jan 2020 18:53:46 +0000
> > > Cc: Philipp Stephani <p.stephani2@gmail.com>, 30373@debbugs.gnu.org, sjindel@google.com
> > >
> > > If I'm reading the test correctly, it depends on garbage-collect
> > > actually collecting an unreferenced vector; since our GC's
> > > conservative, that might not be working for you, if a word that
> > > happens to look like a reference to the vector is still on the stack.
> > > (Or it might be something else entirely, but I don't think the test as
> > > it stands is correct).
> >
> > You are probably right, because I see the same failure on GNU/Linux,
> > in an x86_64 unoptimized build:
>
> I see it too. Fprogn keeps the value of the first sub-form alive while
> evaluating the second one.
>
> We can "fix" Fprogn to discard val early in unoptimized builds, and
> that might make GC behavior slightly less surprising.
>
> But it won't properly fix this test.

Ah yeah, looks like the test was too brittle. (For some reason, it
worked fine on macOS.) I've now installed a patch that creates 100
dangling functions; hopefully that increases the likelihood of at
least one getting garbage-collected.