emacs-diffs
[Top][All Lists]
Advanced

[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))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]