[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp c6f4238 1/2: Fix describe function arglist for nativ
From: |
Andrea Corallo |
Subject: |
feature/native-comp c6f4238 1/2: Fix describe function arglist for native compiled lisp/d (bug#42572) |
Date: |
Mon, 31 Aug 2020 16:42:30 -0400 (EDT) |
branch: feature/native-comp
commit c6f42387e32a4e99cd9ddd203ab51f3c5694054e
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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 1b01496..01817ab 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 3371136..b795593 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 2a078be..b147bd6 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))))