]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix describe function arglist for native compiled lisp/d (bug#42572)
authorAndrea Corallo <akrl@sdf.org>
Mon, 31 Aug 2020 20:06:49 +0000 (22:06 +0200)
committerAndrea Corallo <akrl@sdf.org>
Mon, 31 Aug 2020 20:36:58 +0000 (22:36 +0200)
* 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
src/data.c
test/src/comp-tests.el

index 1b0149616f2e8be0b91b4031067656ad0b4e33b2..01817ab95db26843a6fa5ccce56a5680e60420aa 100644 (file)
@@ -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
index 33711368f137be36ae576c2d2df494571279017f..b7955932b8572a403e7e75c6809a639c6cbf1c59 100644 (file)
@@ -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);
index 2a078be8cb05d6d4e668ae17735695b446b3a5a7..b147bd6789cbf5aed769b278b66affa0084a300a 100644 (file)
@@ -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))))