Re: [PATCH] Reimplement module functions

[Philipp Stephani <p.stephani2@gmail.com>]

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

Philipp Stephani <p.stephani2@gmail.com> schrieb am So., 14. Mai 2017 um
20:09 Uhr:

> Instead of a lambda, create a new type containing all data required to
> call the function, and support it in the evaluator.  Because this type
> now also needs to store the function documentation, it is too big for
> Lisp_Misc; use a pseudovector instead.  That also has the nice benefit
> that we don't have to add special support to the garbage collector.
>
> Since the new type is user-visible, give it a predicate.
>
> Now we can easily support 'help-function-args' and 'func-arity'; add
> unit tests for these.
>
> * src/lisp.h (allocate_module_function, MODULE_FUNCTIONP)
> (XMODULE_FUNCTION): New pseudovector type 'module function'.
>
> * src/eval.c (FUNCTIONP): Also treat module functions as functions.
> (funcall_lambda, Ffuncall, eval_sub): Add support for calling module
> functions.
> (Ffunc_arity): Add support for detecting the arity of module
> functions.
>
> * src/emacs-module.c (module_make_function): Adapt to new structure.
> Return module function object directly instead of wrapping it in a
> lambda; remove FIXME.
> (funcall_module): New function to call module functions.  Replaces
> `internal--module-call' and is called directly from eval.c.
> (syms_of_module): Remove internal helper function, which is no longer
> needed.
> (module_function_arity): New helper function.
>
> * src/data.c (Ftype_of): Adapt to new implementation.
> (Fmodule_function_p, syms_of_data): New user-visible function.  Now
> that module functions are first-class objects, they deserve a
> predicate.  Define it even if not compiled with --enable-modules so
> that Lisp code doesn't have to check for the function's existence.
>
> * src/doc.c (Fdocumentation): Support module functions.
>
> * src/print.c (print_object): Adapt to new implementation.
>
> * src/alloc.c (mark_object): Specialized garbage collector support is
> no longer needed.
>
> * lisp/help.el (help-function-arglist): Support module functions.
> While there, simplify the arity calculation by using `func-arity',
> which does the right thing for all kinds of functions.
>
> * test/data/emacs-module/mod-test.c: Amend docstring so we can test
> the argument list.
>
> * test/src/emacs-module-tests.el (mod-test-sum-docstring): Adapt to
> new docstring.
> (mod-test-non-local-exit-signal-test): Because `internal--module-call'
> is gone, the backtrace has changed and no longer leaks the
> implementation.
> (module--func-arity): New test for `func-arity'.
> (module--help-function-arglist): New test for `help-function-arglist'.
> ---
>  etc/NEWS                          |  6 +++
>  lisp/help.el                      | 19 +++-----
>  src/alloc.c                       |  8 ----
>  src/data.c                        | 13 +++++-
>  src/doc.c                         |  2 +
>  src/emacs-module.c                | 50 +++++++++------------
>  src/eval.c                        | 17 +++++--
>  src/lisp.h                        | 94
> +++++++++++++++++++++++----------------
>  src/print.c                       | 12 ++---
>  test/data/emacs-module/mod-test.c |  2 +-
>  test/src/emacs-module-tests.el    | 55 ++++++++++++-----------
>  11 files changed, 153 insertions(+), 125 deletions(-)
>
> diff --git a/etc/NEWS b/etc/NEWS
> index 6667a44c29..8668bab5f6 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -923,6 +923,12 @@ instead of its first.
>  renamed to 'lread--old-style-backquotes'.  No user code should use
>  this variable.
>
> ++++
> +** Module functions are now implemented slightly differently; in
> +particular, the function 'internal--module-call' has been removed.
> +Code that depends on undocumented internals of the module system might
> +break.
> +
>
>  * Lisp Changes in Emacs 26.1
>
> diff --git a/lisp/help.el b/lisp/help.el
> index 26be3b0e07..361ab2a01e 100644
> --- a/lisp/help.el
> +++ b/lisp/help.el
> @@ -1430,7 +1430,7 @@ help-function-arglist
>     ((eq (car-safe def) 'lambda) (nth 1 def))
>     ((eq (car-safe def) 'closure) (nth 2 def))
>     ((or (and (byte-code-function-p def) (integerp (aref def 0)))
> -        (subrp def))
> +        (subrp def) (module-function-p def))
>      (or (when preserve-names
>            (let* ((doc (condition-case nil (documentation def) (error
> nil)))
>                   (docargs (if doc (car (help-split-fundoc doc nil))))
> @@ -1446,25 +1446,18 @@ help-function-arglist
>                                 (not (string-match "\\." name)))))
>                  (setq valid nil)))
>              (when valid arglist)))
> -        (let* ((args-desc (if (not (subrp def))
> -                              (aref def 0)
> -                            (let ((a (subr-arity def)))
> -                              (logior (car a)
> -                                      (if (numberp (cdr a))
> -                                          (lsh (cdr a) 8)
> -                                        (lsh 1 7))))))
> -               (max (lsh args-desc -8))
> -               (min (logand args-desc 127))
> -               (rest (logand args-desc 128))
> +        (let* ((arity (func-arity def))
> +               (max (cdr arity))
> +               (min (car arity))
>                 (arglist ()))
>            (dotimes (i min)
>              (push (intern (concat "arg" (number-to-string (1+ i))))
> arglist))
> -          (when (> max min)
> +          (when (and (integerp max) (> max min))
>              (push '&optional arglist)
>              (dotimes (i (- max min))
>                (push (intern (concat "arg" (number-to-string (+ 1 i min))))
>                      arglist)))
> -          (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
> +          (unless (integerp max) (push '&rest arglist) (push 'rest
> arglist))
>            (nreverse arglist))))
>     ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
>      "[Arg list not available until function definition is loaded.]")
> diff --git a/src/alloc.c b/src/alloc.c
> index faa14eebb3..b473ebd7de 100644
> --- a/src/alloc.c
> +++ b/src/alloc.c
> @@ -3942,13 +3942,6 @@ make_user_ptr (void (*finalizer) (void *), void *p)
>    uptr->p = p;
>    return obj;
>  }
> -
> -/* Create a new module function environment object.  */
> -Lisp_Object
> -make_module_function (void)
> -{
> -  return allocate_misc (Lisp_Misc_Module_Function);
> -}
>  #endif
>
>  static void
> @@ -6640,7 +6633,6 @@ mark_object (Lisp_Object arg)
>
>  #ifdef HAVE_MODULES
>         case Lisp_Misc_User_Ptr:
> -        case Lisp_Misc_Module_Function:
>           XMISCANY (obj)->gcmarkbit = true;
>           break;
>  #endif
> diff --git a/src/data.c b/src/data.c
> index 44f7ba0e88..f75b2962d7 100644
> --- a/src/data.c
> +++ b/src/data.c
> @@ -233,8 +233,6 @@ for example, (type-of 1) returns `integer'.  */)
>          case Lisp_Misc_Finalizer:
>            return Qfinalizer;
>  #ifdef HAVE_MODULES
> -        case Lisp_Misc_Module_Function:
> -          return Qmodule_function;
>         case Lisp_Misc_User_Ptr:
>           return Quser_ptr;
>  #endif
> @@ -278,6 +276,8 @@ for example, (type-of 1) returns `integer'.  */)
>              else
>                return t;
>            }
> +        case PVEC_MODULE_FUNCTION:
> +          return Qmodule_function;
>          /* "Impossible" cases.  */
>          case PVEC_XWIDGET:
>          case PVEC_OTHER:
> @@ -494,6 +494,14 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p,
> Sbyte_code_function_p,
>    return Qnil;
>  }
>
> +DEFUN ("module-function-p", Fmodule_function_p, Smodule_function_p, 1, 1,
> NULL,
> +       doc: /* Return t if OBJECT is a function loaded from a dynamic
> module.  */
> +       attributes: const)
> +  (Lisp_Object object)
> +{
> +  return MODULE_FUNCTIONP (object) ? Qt : Qnil;
> +}
> +
>  DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
>         doc: /* Return t if OBJECT is a character or a string.  */
>         attributes: const)
> @@ -3790,6 +3798,7 @@ syms_of_data (void)
>    defsubr (&Smarkerp);
>    defsubr (&Ssubrp);
>    defsubr (&Sbyte_code_function_p);
> +  defsubr (&Smodule_function_p);
>    defsubr (&Schar_or_string_p);
>    defsubr (&Sthreadp);
>    defsubr (&Smutexp);
> diff --git a/src/doc.c b/src/doc.c
> index dd674e3bc0..345e18b918 100644
> --- a/src/doc.c
> +++ b/src/doc.c
> @@ -340,6 +340,8 @@ string is passed through `substitute-command-keys'.
> */)
>      fun = XCDR (fun);
>    if (SUBRP (fun))
>      doc = make_number (XSUBR (fun)->doc);
> +  else if (MODULE_FUNCTIONP (fun))
> +    doc = XMODULE_FUNCTION (fun)->documentation;
>    else if (COMPILEDP (fun))
>      {
>        if (PVSIZE (fun) <= COMPILED_DOC_STRING)
> diff --git a/src/emacs-module.c b/src/emacs-module.c
> index cd025a1396..abe2a92276 100644
> --- a/src/emacs-module.c
> +++ b/src/emacs-module.c
> @@ -361,30 +361,24 @@ module_make_function (emacs_env *env, ptrdiff_t
> min_arity, ptrdiff_t max_arity,
>              : min_arity <= max_arity)))
>      xsignal2 (Qinvalid_arity, make_number (min_arity), make_number
> (max_arity));
>
> -  Lisp_Object envobj = make_module_function ();
> -  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
> +  struct Lisp_Module_Function *envptr = allocate_module_function ();
>    envptr->min_arity = min_arity;
>    envptr->max_arity = max_arity;
>    envptr->subr = subr;
>    envptr->data = data;
>
> -  Lisp_Object doc = Qnil;
>    if (documentation)
>      {
>        AUTO_STRING (unibyte_doc, documentation);
> -      doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false);
> +      envptr->documentation =
> +        code_convert_string_norecord (unibyte_doc, Qutf_8, false);
>      }
>
> -  /* FIXME: Use a bytecompiled object, or even better a subr.  */
> -  Lisp_Object ret = list4 (Qlambda,
> -                           list2 (Qand_rest, Qargs),
> -                           doc,
> -                           list4 (Qapply,
> -                                  list2 (Qfunction,
> Qinternal__module_call),
> -                                  envobj,
> -                                  Qargs));
> +  Lisp_Object envobj;
> +  XSET_MODULE_FUNCTION (envobj, envptr);
> +  eassert (MODULE_FUNCTIONP (envobj));
>
> -  return lisp_to_value (ret);
> +  return lisp_to_value (envobj);
>  }
>
>  static emacs_value
> @@ -647,17 +641,11 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1,
> 1, 0,
>    return Qt;
>  }
>
> -DEFUN ("internal--module-call", Finternal_module_call,
> Sinternal_module_call, 1, MANY, 0,
> -       doc: /* Internal function to call a module function.
> -ENVOBJ is a save pointer to a module_fun_env structure.
> -ARGLIST is a list of arguments passed to SUBRPTR.
> -usage: (module-call ENVOBJ &rest ARGLIST)   */)
> -  (ptrdiff_t nargs, Lisp_Object *arglist)
> +Lisp_Object
> +funcall_module (const struct Lisp_Module_Function *const envptr,
> +                ptrdiff_t nargs, Lisp_Object *arglist)
>  {
> -  Lisp_Object envobj = arglist[0];
> -  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
> -  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
> -  EMACS_INT len = nargs - 1;
> +  EMACS_INT len = nargs;
>    eassume (0 <= envptr->min_arity);
>    if (! (envptr->min_arity <= len
>          && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX :
> envptr->max_arity)))
> @@ -671,12 +659,12 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
>    USE_SAFE_ALLOCA;
>    emacs_value *args;
>    if (plain_values)
> -    args = (emacs_value *) arglist + 1;
> +    args = (emacs_value *) arglist;
>    else
>      {
>        args = SAFE_ALLOCA (len * sizeof *args);
>        for (ptrdiff_t i = 0; i < len; i++)
> -       args[i] = lisp_to_value (arglist[i + 1]);
> +       args[i] = lisp_to_value (arglist[i]);
>      }
>
>    emacs_value ret = envptr->subr (&pub, len, args, envptr->data);
> @@ -708,6 +696,15 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
>      }
>  }
>
> +Lisp_Object
> +module_function_arity (const struct Lisp_Module_Function *const function)
> +{
> +  const short minargs = function->min_arity;
> +  const short maxargs = function->max_arity;
> +  return Fcons (make_number (minargs),
> +               maxargs == MANY ? Qmany : make_number (maxargs));
> +}
> +
>
>  /* Helper functions.  */
>
> @@ -1022,7 +1019,4 @@ syms_of_module (void)
>    DEFSYM (Qmodule_function_p, "module-function-p");
>
>    defsubr (&Smodule_load);
> -
> -  DEFSYM (Qinternal__module_call, "internal--module-call");
> -  defsubr (&Sinternal_module_call);
>  }
> diff --git a/src/eval.c b/src/eval.c
> index 848955c279..2a77fc1360 100644
> --- a/src/eval.c
> +++ b/src/eval.c
> @@ -2261,7 +2261,7 @@ eval_sub (Lisp_Object form)
>             }
>         }
>      }
> -  else if (COMPILEDP (fun))
> +  else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
>      return apply_lambda (fun, original_args, count);
>    else
>      {
> @@ -2687,7 +2687,7 @@ FUNCTIONP (Lisp_Object object)
>
>    if (SUBRP (object))
>      return XSUBR (object)->max_args != UNEVALLED;
> -  else if (COMPILEDP (object))
> +  else if (COMPILEDP (object) || MODULE_FUNCTIONP (object))
>      return true;
>    else if (CONSP (object))
>      {
> @@ -2742,7 +2742,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
>
>    if (SUBRP (fun))
>      val = funcall_subr (XSUBR (fun), numargs, args + 1);
> -  else if (COMPILEDP (fun))
> +  else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
>      val = funcall_lambda (fun, numargs, args + 1);
>    else
>      {
> @@ -2892,7 +2892,8 @@ apply_lambda (Lisp_Object fun, Lisp_Object args,
> ptrdiff_t count)
>
>  /* Apply a Lisp function FUN to the NARGS evaluated arguments in
> ARG_VECTOR
>     and return the result of evaluation.
> -   FUN must be either a lambda-expression or a compiled-code object.  */
> +   FUN must be either a lambda-expression, a compiled-code object,
> +   or a module function.  */
>
>  static Lisp_Object
>  funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
> @@ -2949,6 +2950,10 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
>         }
>        lexenv = Qnil;
>      }
> +#ifdef HAVE_MODULES
> +  else if (MODULE_FUNCTIONP (fun))
> +    return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector);
> +#endif
>    else
>      emacs_abort ();
>
> @@ -3060,6 +3065,10 @@ function with `&rest' args, or `unevalled' for a
> special form.  */)
>      result = Fsubr_arity (function);
>    else if (COMPILEDP (function))
>      result = lambda_arity (function);
> +#ifdef HAVE_MODULES
> +  else if (MODULE_FUNCTIONP (function))
> +    result = module_function_arity (XMODULE_FUNCTION (function));
> +#endif
>    else
>      {
>        if (NILP (function))
> diff --git a/src/lisp.h b/src/lisp.h
> index de3a548cb6..ec8a8b1c09 100644
> --- a/src/lisp.h
> +++ b/src/lisp.h
> @@ -464,7 +464,6 @@ enum Lisp_Misc_Type
>      Lisp_Misc_Save_Value,
>      Lisp_Misc_Finalizer,
>  #ifdef HAVE_MODULES
> -    Lisp_Misc_Module_Function,
>      Lisp_Misc_User_Ptr,
>  #endif
>      /* Currently floats are not a misc type,
> @@ -885,6 +884,7 @@ enum pvec_type
>    PVEC_THREAD,
>    PVEC_MUTEX,
>    PVEC_CONDVAR,
> +  PVEC_MODULE_FUNCTION,
>
>    /* These should be last, check internal_equal to see why.  */
>    PVEC_COMPILED,
> @@ -2386,28 +2386,6 @@ struct Lisp_User_Ptr
>    void (*finalizer) (void *);
>    void *p;
>  };
> -
> -#include "emacs-module.h"
> -
> -/* Function prototype for the module Lisp functions.  */
> -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
> -                                  emacs_value [], void *);
> -
> -/* Function environments.  */
> -
> -/* A function environment is an auxiliary structure used by
> -   `module_make_function' to store information about a module
> -   function.  It is stored in a save pointer and retrieved by
> -   `internal--module-call'.  Its members correspond to the arguments
> -   given to `module_make_function'.  */
> -
> -struct Lisp_Module_Function
> -{
> -  struct Lisp_Misc_Any base;
> -  ptrdiff_t min_arity, max_arity;
> -  emacs_subr subr;
> -  void *data;
> -};
>  #endif
>
>  /* A finalizer sentinel.  */
> @@ -2460,7 +2438,6 @@ union Lisp_Misc
>      struct Lisp_Finalizer u_finalizer;
>  #ifdef HAVE_MODULES
>      struct Lisp_User_Ptr u_user_ptr;
> -    struct Lisp_Module_Function u_module_function;
>  #endif
>    };
>
> @@ -2509,19 +2486,6 @@ XUSER_PTR (Lisp_Object a)
>    eassert (USER_PTRP (a));
>    return XUNTAG (a, Lisp_Misc);
>  }
> -
> -INLINE bool
> -MODULE_FUNCTIONP (Lisp_Object o)
> -{
> -  return MISCP (o) && XMISCTYPE (o) == Lisp_Misc_Module_Function;
> -}
> -
> -INLINE struct Lisp_Module_Function *
> -XMODULE_FUNCTION (Lisp_Object o)
> -{
> -  eassert (MODULE_FUNCTIONP (o));
> -  return XUNTAG (o, Lisp_Misc);
> -}
>  #endif
>
>
> @@ -3923,12 +3887,66 @@ extern void get_backtrace (Lisp_Object array);
>  Lisp_Object backtrace_top_function (void);
>  extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
>
> +#include "emacs-module.h"
> +
> +/* Function prototype for the module Lisp functions.  */
> +typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
> +                                  emacs_value [], void *);
> +
> +/* Function environments.  */
> +
> +/* A function environment is an auxiliary structure used by
> +   `module_make_function' to store information about a module
> +   function.  It is stored in a pseudovector.  Its members correspond
> +   to the arguments given to `module_make_function'.  */
> +
> +struct Lisp_Module_Function
> +{
> +  struct vectorlike_header header;
> +
> +  /* Fields traced by GC; these must come first.  */
> +  Lisp_Object documentation;
> +
> +  /* Fields ignored by GC.  */
> +  ptrdiff_t min_arity, max_arity;
> +  emacs_subr subr;
> +  void *data;
> +};
> +
> +INLINE struct Lisp_Module_Function *
> +allocate_module_function (void)
> +{
> +  return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
> +                                /* Name of the first field to be
> +                                   ignored by GC.  */
> +                                min_arity,
> +                                PVEC_MODULE_FUNCTION);
> +}
> +
> +INLINE bool
> +MODULE_FUNCTIONP (Lisp_Object o)
> +{
> +  return PSEUDOVECTORP (o, PVEC_MODULE_FUNCTION);
> +}
> +
> +INLINE struct Lisp_Module_Function *
> +XMODULE_FUNCTION (Lisp_Object o)
> +{
> +  eassert (MODULE_FUNCTIONP (o));
> +  return XUNTAG (o, Lisp_Vectorlike);
> +}
> +
> +#define XSET_MODULE_FUNCTION(var, ptr)                  \
> +  (XSETPSEUDOVECTOR (var, ptr, PVEC_MODULE_FUNCTION))
> +
>  #ifdef HAVE_MODULES
>  /* Defined in alloc.c.  */
>  extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
> -extern Lisp_Object make_module_function (void);
>
>  /* Defined in emacs-module.c.  */
> +extern Lisp_Object funcall_module (const struct Lisp_Module_Function *,
> +                                   ptrdiff_t, Lisp_Object *);
> +extern Lisp_Object module_function_arity (const struct
> Lisp_Module_Function *);
>  extern Lisp_Object module_format_fun_env (const struct
> Lisp_Module_Function *);
>  extern void syms_of_module (void);
>  #endif
> diff --git a/src/print.c b/src/print.c
> index 7e411a80c8..be2e16a749 100644
> --- a/src/print.c
> +++ b/src/print.c
> @@ -2051,6 +2051,13 @@ print_object (Lisp_Object obj, Lisp_Object
> printcharfun, bool escapeflag)
>          }
>          break;
>
> +#ifdef HAVE_MODULES
> +      case PVEC_MODULE_FUNCTION:
> +        print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
> +                      printcharfun);
> +        break;
> +#endif
> +
>          case PVEC_OTHER:
>          case PVEC_FREE:
>            emacs_abort ();
> @@ -2103,11 +2110,6 @@ print_object (Lisp_Object obj, Lisp_Object
> printcharfun, bool escapeflag)
>             printchar ('>', printcharfun);
>             break;
>           }
> -
> -        case Lisp_Misc_Module_Function:
> -          print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
> -                        printcharfun);
> -          break;
>  #endif
>
>          case Lisp_Misc_Finalizer:
> diff --git a/test/data/emacs-module/mod-test.c
> b/test/data/emacs-module/mod-test.c
> index 50be8620bd..309179d150 100644
> --- a/test/data/emacs-module/mod-test.c
> +++ b/test/data/emacs-module/mod-test.c
> @@ -249,7 +249,7 @@ emacs_module_init (struct emacs_runtime *ert)
>                  env->make_function (env, amin, amax, csym, doc, data))
>
>    DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
> -  DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL);
> +  DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)",
> NULL);
>    DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
>    DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
>    DEFUN ("mod-test-non-local-exit-funcall",
> Fmod_test_non_local_exit_funcall,
> diff --git a/test/src/emacs-module-tests.el
> b/test/src/emacs-module-tests.el
> index eb7c82b2f6..5a6554c7b9 100644
> --- a/test/src/emacs-module-tests.el
> +++ b/test/src/emacs-module-tests.el
> @@ -57,35 +57,24 @@
>                  :type 'overflow-error))
>
>  (ert-deftest mod-test-sum-docstring ()
> -  (should (string= (documentation 'mod-test-sum) "Return A + B")))
> +  (should (string= (documentation 'mod-test-sum) "Return A + B\n\n(fn a
> b)")))
>
>  (ert-deftest module-function-object ()
>    "Extract and test the implementation of a module function.
>  This test needs to be changed whenever the implementation
>  changes."
>    (let ((func (symbol-function #'mod-test-sum)))
> -    (should (consp func))
> -    (should (equal (length func) 4))
> -    (should (equal (nth 0 func) 'lambda))
> -    (should (equal (nth 1 func) '(&rest args)))
> -    (should (equal (nth 2 func) "Return A + B"))
> -    (let ((body (nth 3 func)))
> -      (should (consp body))
> -      (should (equal (length body) 4))
> -      (should (equal (nth 0 body) #'apply))
> -      (should (equal (nth 1 body) '#'internal--module-call))
> -      (should (equal (nth 3 body) 'args))
> -      (let ((obj (nth 2 body)))
> -        (should (equal (type-of obj) 'module-function))
> -        (should (string-match-p
> -                 (rx (or "#<module function Fmod_test_sum from "
> -                         ;; MS-Windows doesn't allow us to get the
> -                         ;; function name, only the address.
> -                         (and "#<module function at 0x"
> -                              (one-or-more hex-digit)
> -                              " from "))
> -                     (* nonl) "mod-test" (* nonl) ">")
> -                 (prin1-to-string obj)))))))
> +    (should (module-function-p func))
> +    (should (equal (type-of func) 'module-function))
> +    (should (string-match-p
> +             (rx (or "#<module function Fmod_test_sum from "
> +                     ;; MS-Windows doesn't allow us to get the
> +                     ;; function name, only the address.
> +                     (and "#<module function at 0x"
> +                          (one-or-more hex-digit)
> +                          " from "))
> +                 (* nonl) "mod-test" (* nonl) ">")
> +             (prin1-to-string func)))))
>
>  ;;
>  ;; Non-local exists (throw, signal).
> @@ -103,9 +92,7 @@
>         (mod-test-signal)))
>      (should (equal debugger-args '(error (error . 56))))
>      (should (string-match-p
> -             (rx bol "  internal--module-call(" (+ nonl) ?\) ?\n
> -                 "  apply(internal--module-call " (+ nonl) ?\) ?\n
> -                 "  mod-test-signal()" eol)
> +             (rx bol "  mod-test-signal()" eol)
>               backtrace))))
>
>  (ert-deftest mod-test-non-local-exit-throw-test ()
> @@ -174,3 +161,19 @@ multiply-string
>
>          (should (eq (mod-test-vector-fill v-test e) t))
>          (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
> +
> +(ert-deftest module--func-arity ()
> +  (should (equal (func-arity #'mod-test-return-t) '(1 . 1)))
> +  (should (equal (func-arity #'mod-test-sum) '(2 . 2))))
> +
> +(ert-deftest module--help-function-arglist ()
> +  (should (equal (help-function-arglist #'mod-test-return-t
> :preserve-names)
> +                 '(arg1)))
> +  (should (equal (help-function-arglist #'mod-test-return-t)
> +                 '(arg1)))
> +  (should (equal (help-function-arglist #'mod-test-sum :preserve-names)
> +                 '(a b)))
> +  (should (equal (help-function-arglist #'mod-test-sum)
> +                 '(arg1 arg2))))
> +
> +;;; emacs-module-tests.el ends here
> --
> 2.13.0
>
>
Pushed as 31fded0370.

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