From c6f42387e32a4e99cd9ddd203ab51f3c5694054e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 31 Aug 2020 22:06:49 +0200 Subject: [PATCH] Fix describe function arglist for native compiled lisp/d (bug#42572) * lisp/help.el (help-function-arglist): Handle the case of native compiled lisp/d. * src/data.c (syms_of_data): Register new subrs. (Fsubr_native_dyn_p, Fsubr_native_lambda_list): New primitives. * test/src/comp-tests.el (comp-tests-dynamic-help-arglist): New test. --- lisp/help.el | 1 + src/data.c | 29 +++++++++++++++++++++++++++-- test/src/comp-tests.el | 7 +++++++ 3 files changed, 35 insertions(+), 2 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index 1b0149616f2..01817ab95db 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1337,6 +1337,7 @@ the same names as used in the original source code, when possible." ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) ((eq (car-safe def) 'closure) (nth 2 def)) + ((subr-native-dyn-p def) (subr-native-lambda-list def)) ((or (and (byte-code-function-p def) (integerp (aref def 0))) (subrp def) (module-function-p def)) (or (when preserve-names diff --git a/src/data.c b/src/data.c index 33711368f13..b7955932b85 100644 --- a/src/data.c +++ b/src/data.c @@ -875,14 +875,37 @@ SUBR must be a built-in function. */) } DEFUN ("subr-native-elisp-p", Fsubr_native_elisp_p, Ssubr_native_elisp_p, 1, 1, - 0, doc: /* Return t if the object is native compiled lisp function, -nil otherwise. */) + 0, doc: /* Return t if the object is native compiled lisp +function, nil otherwise. */) (Lisp_Object object) { return SUBR_NATIVE_COMPILEDP (object) ? Qt : Qnil; } #ifdef HAVE_NATIVE_COMP + +DEFUN ("subr-native-dyn-p", Fsubr_native_dyn_p, + Ssubr_native_dyn_p, 1, 1, 0, + doc: /* Return t if the subr is native compiled lisp/d +function, nil otherwise. */) + (Lisp_Object subr) +{ + return SUBR_NATIVE_COMPILED_DYNP (subr) ? Qt : Qnil; +} + +DEFUN ("subr-native-lambda-list", Fsubr_native_lambda_list, + Ssubr_native_lambda_list, 1, 1, 0, + doc: /* Return the lambda list of native compiled lisp/d +function. */) + (Lisp_Object subr) +{ + CHECK_SUBR (subr); + + return SUBR_NATIVE_COMPILED_DYNP (subr) + ? XSUBR (subr)->lambda_list[0] + : Qnil; +} + DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit, Ssubr_native_comp_unit, 1, 1, 0, doc: /* Return the native compilation unit. */) @@ -4028,6 +4051,8 @@ syms_of_data (void) defsubr (&Ssubr_name); defsubr (&Ssubr_native_elisp_p); #ifdef HAVE_NATIVE_COMP + defsubr (&Ssubr_native_dyn_p); + defsubr (&Ssubr_native_lambda_list); defsubr (&Ssubr_native_comp_unit); defsubr (&Snative_comp_unit_file); defsubr (&Snative_comp_unit_set_file); diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 2a078be8cb0..b147bd6789c 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -582,6 +582,13 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (should (equal '(2 . many) (func-arity #'comp-tests-ffuncall-callee-opt-rest-dyn-f)))) +(ert-deftest comp-tests-dynamic-help-arglist () + "Test `help-function-arglist' works on lisp/d (bug#42572)." + (should (equal (help-function-arglist + (symbol-function #'comp-tests-ffuncall-callee-opt-rest-dyn-f) + t) + '(a b &optional c &rest d)))) + (ert-deftest comp-tests-cl-macro-exp () "Verify CL macro expansion (bug#42088)." (should (equal (comp-tests-cl-macro-exp-f) '(a b)))) -- 2.39.5