From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Philipp Stephani Newsgroups: gmane.emacs.devel Subject: [PATCH] Reimplement module functions Date: Sun, 14 May 2017 20:09:01 +0200 Message-ID: <20170514180901.95283-1-phst@google.com> References: NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1494785368 8532 195.159.176.226 (14 May 2017 18:09:28 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 14 May 2017 18:09:28 +0000 (UTC) Cc: Philipp Stephani To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun May 14 20:09:24 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d9xxL-00025e-6q for ged-emacs-devel@m.gmane.org; Sun, 14 May 2017 20:09:23 +0200 Original-Received: from localhost ([::1]:33539 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d9xxQ-000516-Fd for ged-emacs-devel@m.gmane.org; Sun, 14 May 2017 14:09:28 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58642) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d9xxA-0004ym-Qo for emacs-devel@gnu.org; Sun, 14 May 2017 14:09:15 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d9xx7-0001DW-DP for emacs-devel@gnu.org; Sun, 14 May 2017 14:09:12 -0400 Original-Received: from mail-wr0-x243.google.com ([2a00:1450:400c:c0c::243]:35451) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d9xx7-0001Cf-08 for emacs-devel@gnu.org; Sun, 14 May 2017 14:09:09 -0400 Original-Received: by mail-wr0-x243.google.com with SMTP id g12so12337467wrg.2 for ; Sun, 14 May 2017 11:09:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references; bh=+z+gGzdJG+SGClkvMlruurrgGzUrWRddMeHsFlwTESs=; b=toMCSX6OchspZ3u/yVudlJIjMGdfW8c4yigqaV/afTUrX/8l+TWOLnER0nwpyoHc/I Ucd6QyK/lx0RiV8BULTBCAFrjAlqr93C5rwtHW9FZ+kNwICudb+jQf5r8KWfUZMByf0X Env6OTlbnMtxkL27YRz/wFKAHpk45OKE6bur2F6CtqSFxXKG7pEn3eNLuRAVD7bMcAT7 lP1ahm2bSrQ+/hQ/Mwa+Zwloz0frt+W6w/vcJIbLcIMorHFjgsH9DY2VyhYsqA3PGAsD jbUknzZmUZReQxCdjeUvxi1LC7bmVtVbRSWee4T2rAzM7UPwTVdnQULdhjWGbj/b75ex JfTg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references; bh=+z+gGzdJG+SGClkvMlruurrgGzUrWRddMeHsFlwTESs=; b=ajQ0MaCT1xjTFirJPhIvOE6CyeetFw0Kh2p27bTRg2CbWWdGDmrKbjo/VBsMsiohZq sKRYIIh5Clhwja15RqWzLKBSoL1aUK1MfVor86PpVwbdt/S3/nNtTL0DmfoNaqHzUUNW +0n2eJ0n0BpYfWebeCMkdBAbpq0M0zoBkqco15UtL7yUAcZT2F4irnAfVRACo2LHrOau UFGpjhfj+Bfn9U5Aqcpg/3f+f8Io10ki/I9Ozeq9nhDENYWBkEr105C1ihta9PI9lq65 JenmvCTd46g5432Fr5qFr5ZxZXhDWMB9xwc9zHsNwvgclWKzjk7Sym/mgM5Rh2UVSojn IHGQ== X-Gm-Message-State: AODbwcDDKJvT4OayVInbrdmyItYfha2/hz3TUXSYBlFgY4mpq7v433/O fdHhBM9emJ3C0A== X-Received: by 10.223.171.18 with SMTP id q18mr1570416wrc.178.1494785347639; Sun, 14 May 2017 11:09:07 -0700 (PDT) Original-Received: from p.cm.cablesurf.de (46.128.198.151.dynamic.cablesurf.de. [46.128.198.151]) by smtp.gmail.com with ESMTPSA id x9sm9004555wmb.21.2017.05.14.11.09.05 (version=TLS1 cipher=AES128-SHA bits=128/128); Sun, 14 May 2017 11:09:06 -0700 (PDT) X-Google-Original-From: Philipp Stephani X-Mailer: git-send-email 2.13.0 In-Reply-To: X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c0c::243 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:214844 Archived-At: 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 "#") - (prin1-to-string obj))))))) + (should (module-function-p func)) + (should (equal (type-of func) 'module-function)) + (should (string-match-p + (rx (or "#") + (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