Philipp Stephani
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 "# - ;; MS-Windows doesn't allow us to get the
> - ;; function name, only the address.
> - (and "# - (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 "# + ;; MS-Windows doesn't allow us to get the
> + ;; function name, only the address.
> + (and "# + (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.