Commit 3b0080de authored by Philipp Stephani's avatar Philipp Stephani

Rework printing of module functions

Fix a FIXME in emacs-module.c.  Put the printing into print.c, like
other types.

* src/print.c (print_vectorlike): Add code to print module functions.

* src/emacs-module.c (funcall_module): Stop calling
'module_format_fun_env'.  Now that module functions are first-class
objects, they can be added to signal data directly.
(module_handle_signal): Remove now-unused function
'module_format_fun_env'.

* test/src/emacs-module-tests.el (mod-test-sum-test): Adapt unit test.

* src/eval.c (funcall_lambda): Adapt call to changed signature of
'funcall_module'.
parent 18396997
......@@ -645,14 +645,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
}
Lisp_Object
funcall_module (const struct Lisp_Module_Function *const function,
ptrdiff_t nargs, Lisp_Object *arglist)
funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
{
eassume (0 <= function->min_arity);
if (! (function->min_arity <= nargs
&& (function->max_arity < 0 || nargs <= function->max_arity)))
xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (function),
make_number (nargs));
const struct Lisp_Module_Function *func = XMODULE_FUNCTION (function);
eassume (0 <= func->min_arity);
if (! (func->min_arity <= nargs
&& (func->max_arity < 0 || nargs <= func->max_arity)))
xsignal2 (Qwrong_number_of_arguments, function, make_natnum (nargs));
emacs_env pub;
struct emacs_env_private priv;
......@@ -669,7 +668,7 @@ funcall_module (const struct Lisp_Module_Function *const function,
args[i] = lisp_to_value (arglist[i]);
}
emacs_value ret = function->subr (&pub, nargs, args, function->data);
emacs_value ret = func->subr (&pub, nargs, args, func->data);
SAFE_FREE ();
eassert (&priv == pub.private_members);
......@@ -941,35 +940,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val));
}
/* Function environments. */
/* Return a string object that contains a user-friendly
representation of the function environment. */
Lisp_Object
module_format_fun_env (const struct Lisp_Module_Function *env)
{
/* Try to print a function name if possible. */
/* FIXME: Move this function into print.c, then use prin1-to-string
above. */
const char *path, *sym;
static char const noaddr_format[] = "#<module function at %p>";
char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
char *buf = buffer;
ptrdiff_t bufsize = sizeof buffer;
ptrdiff_t size
= (dynlib_addr (env->subr, &path, &sym)
? exprintf (&buf, &bufsize, buffer, -1,
"#<module function %s from %s>", sym, path)
: sprintf (buffer, noaddr_format, env->subr));
AUTO_STRING_WITH_LEN (unibyte_result, buffer, size);
Lisp_Object result = code_convert_string_norecord (unibyte_result,
Qutf_8, false);
if (buf != buffer)
xfree (buf);
return result;
}
/* Segment initializer. */
......
......@@ -2952,7 +2952,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector);
return funcall_module (fun, nargs, arg_vector);
#endif
else
emacs_abort ();
......
......@@ -3952,10 +3952,8 @@ XMODULE_FUNCTION (Lisp_Object o)
extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
/* Defined in emacs-module.c. */
extern Lisp_Object funcall_module (const struct Lisp_Module_Function *,
ptrdiff_t, Lisp_Object *);
extern Lisp_Object funcall_module (Lisp_Object, 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
......
......@@ -33,6 +33,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "blockinput.h"
#include "xwidget.h"
#include "dynlib.h"
#include <c-ctype.h>
#include <float.h>
......@@ -1699,8 +1700,33 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
#ifdef HAVE_MODULES
case PVEC_MODULE_FUNCTION:
print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
printcharfun);
{
print_c_string ("#<module function ", printcharfun);
void *ptr = XMODULE_FUNCTION (obj)->subr;
const char *file = NULL;
const char *symbol = NULL;
dynlib_addr (ptr, &file, &symbol);
if (symbol == NULL)
{
print_c_string (" at ", printcharfun);
enum { pointer_bufsize = sizeof ptr * 16 / CHAR_BIT + 2 + 1 };
char buffer[pointer_bufsize];
int needed = snprintf (buffer, sizeof buffer, "%p", ptr);
eassert (needed <= sizeof buffer);
print_c_string (buffer, printcharfun);
}
else
print_c_string (symbol, printcharfun);
if (file != NULL)
{
print_c_string (" from ", printcharfun);
print_c_string (file, printcharfun);
}
printchar ('>', printcharfun);
}
break;
#endif
......
......@@ -31,13 +31,13 @@
(should (= (mod-test-sum 1 2) 3))
(let ((descr (should-error (mod-test-sum 1 2 3))))
(should (eq (car descr) 'wrong-number-of-arguments))
(should (stringp (nth 1 descr)))
(should (module-function-p (nth 1 descr)))
(should (eq 0
(string-match
(concat "#<module function "
"\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
"\\|Fmod_test_sum from .*\\)>")
(nth 1 descr))))
(prin1-to-string (nth 1 descr)))))
(should (= (nth 2 descr) 3)))
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
(should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment