fi
AC_SUBST(MODULES_OBJ)
AC_SUBST(LIBMODULES)
+AC_SUBST(HAVE_MODULES)
+AC_SUBST(MODULES_SUFFIX)
### Use -lpng if available, unless '--with-png=no'.
HAVE_PNG=no
+++ /dev/null
-# Test GNU Emacs modules.
-
-# Copyright 2015-2017 Free Software Foundation, Inc.
-
-# This file is part of GNU Emacs.
-
-# GNU Emacs is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-ROOT = ../..
-EMACS = $(ROOT)/src/emacs
-
-CC = gcc
-LD = gcc
-LDFLAGS =
-
-# On MS-Windows, say "make SO=dll" to build the module
-SO = so
-# -fPIC is a no-op on Windows, but causes a compiler warning
-ifeq ($(SO),dll)
-CFLAGS = -std=gnu99 -ggdb3 -Wall
-else
-CFLAGS = -std=gnu99 -ggdb3 -Wall -fPIC
-endif
-
-all: mod-test.$(SO)
-
-%.$(SO): %.o
- $(LD) -shared $(LDFLAGS) -o $@ $<
-
-%.o: %.c
- $(CC) $(CFLAGS) -I$(ROOT)/src -c $<
-
-check:
- $(EMACS) -batch -l ert -l test.el -f ert-run-tests-batch-and-exit
+++ /dev/null
-/* Test GNU Emacs modules.
-
-Copyright 2015-2017 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <emacs-module.h>
-
-int plugin_is_GPL_compatible;
-
-/* Always return symbol 't'. */
-static emacs_value
-Fmod_test_return_t (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- return env->intern (env, "t");
-}
-
-/* Expose simple sum function. */
-static intmax_t
-sum (intmax_t a, intmax_t b)
-{
- return a + b;
-}
-
-static emacs_value
-Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
-{
- assert (nargs == 2);
-
- intmax_t a = env->extract_integer (env, args[0]);
- intmax_t b = env->extract_integer (env, args[1]);
-
- intmax_t r = sum (a, b);
-
- return env->make_integer (env, r);
-}
-
-
-/* Signal '(error 56). */
-static emacs_value
-Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
- env->non_local_exit_signal (env, env->intern (env, "error"),
- env->make_integer (env, 56));
- return env->intern (env, "nil");
-}
-
-
-/* Throw '(tag 65). */
-static emacs_value
-Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
- env->non_local_exit_throw (env, env->intern (env, "tag"),
- env->make_integer (env, 65));
- return env->intern (env, "nil");
-}
-
-
-/* Call argument function, catch all non-local exists and return
- either normal result or a list describing the non-local exit. */
-static emacs_value
-Fmod_test_non_local_exit_funcall (emacs_env *env, ptrdiff_t nargs,
- emacs_value args[], void *data)
-{
- assert (nargs == 1);
- emacs_value result = env->funcall (env, args[0], 0, NULL);
- emacs_value non_local_exit_symbol, non_local_exit_data;
- enum emacs_funcall_exit code
- = env->non_local_exit_get (env, &non_local_exit_symbol,
- &non_local_exit_data);
- switch (code)
- {
- case emacs_funcall_exit_return:
- return result;
- case emacs_funcall_exit_signal:
- {
- env->non_local_exit_clear (env);
- emacs_value Flist = env->intern (env, "list");
- emacs_value list_args[] = {env->intern (env, "signal"),
- non_local_exit_symbol, non_local_exit_data};
- return env->funcall (env, Flist, 3, list_args);
- }
- case emacs_funcall_exit_throw:
- {
- env->non_local_exit_clear (env);
- emacs_value Flist = env->intern (env, "list");
- emacs_value list_args[] = {env->intern (env, "throw"),
- non_local_exit_symbol, non_local_exit_data};
- return env->funcall (env, Flist, 3, list_args);
- }
- }
-
- /* Never reached. */
- return env->intern (env, "nil");;
-}
-
-
-/* Return a global reference. */
-static emacs_value
-Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- /* Make a big string and make it global. */
- char str[26 * 100];
- for (int i = 0; i < sizeof str; i++)
- str[i] = 'a' + (i % 26);
-
- /* We don't need to null-terminate str. */
- emacs_value lisp_str = env->make_string (env, str, sizeof str);
- return env->make_global_ref (env, lisp_str);
-}
-
-
-/* Return a copy of the argument string where every 'a' is replaced
- with 'b'. */
-static emacs_value
-Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- emacs_value lisp_str = args[0];
- ptrdiff_t size = 0;
- char * buf = NULL;
-
- env->copy_string_contents (env, lisp_str, buf, &size);
- buf = malloc (size);
- env->copy_string_contents (env, lisp_str, buf, &size);
-
- for (ptrdiff_t i = 0; i + 1 < size; i++)
- if (buf[i] == 'a')
- buf[i] = 'b';
-
- return env->make_string (env, buf, size - 1);
-}
-
-
-/* Embedded pointers in lisp objects. */
-
-/* C struct (pointer to) that will be embedded. */
-struct super_struct
-{
- int amazing_int;
- char large_unused_buffer[512];
-};
-
-/* Return a new user-pointer to a super_struct, with amazing_int set
- to the passed parameter. */
-static emacs_value
-Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- struct super_struct *p = calloc (1, sizeof *p);
- p->amazing_int = env->extract_integer (env, args[0]);
- return env->make_user_ptr (env, free, p);
-}
-
-/* Return the amazing_int of a passed 'user-pointer to a super_struct'. */
-static emacs_value
-Fmod_test_userptr_get (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- struct super_struct *p = env->get_user_ptr (env, args[0]);
- return env->make_integer (env, p->amazing_int);
-}
-
-
-/* Fill vector in args[0] with value in args[1]. */
-static emacs_value
-Fmod_test_vector_fill (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- emacs_value vec = args[0];
- emacs_value val = args[1];
- ptrdiff_t size = env->vec_size (env, vec);
- for (ptrdiff_t i = 0; i < size; i++)
- env->vec_set (env, vec, i, val);
- return env->intern (env, "t");
-}
-
-
-/* Return whether all elements of vector in args[0] are 'eq' to value
- in args[1]. */
-static emacs_value
-Fmod_test_vector_eq (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
- void *data)
-{
- emacs_value vec = args[0];
- emacs_value val = args[1];
- ptrdiff_t size = env->vec_size (env, vec);
- for (ptrdiff_t i = 0; i < size; i++)
- if (!env->eq (env, env->vec_get (env, vec, i), val))
- return env->intern (env, "nil");
- return env->intern (env, "t");
-}
-
-
-/* Lisp utilities for easier readability (simple wrappers). */
-
-/* Provide FEATURE to Emacs. */
-static void
-provide (emacs_env *env, const char *feature)
-{
- emacs_value Qfeat = env->intern (env, feature);
- emacs_value Qprovide = env->intern (env, "provide");
- emacs_value args[] = { Qfeat };
-
- env->funcall (env, Qprovide, 1, args);
-}
-
-/* Bind NAME to FUN. */
-static void
-bind_function (emacs_env *env, const char *name, emacs_value Sfun)
-{
- emacs_value Qfset = env->intern (env, "fset");
- emacs_value Qsym = env->intern (env, name);
- emacs_value args[] = { Qsym, Sfun };
-
- env->funcall (env, Qfset, 2, args);
-}
-
-/* Module init function. */
-int
-emacs_module_init (struct emacs_runtime *ert)
-{
- emacs_env *env = ert->get_environment (ert);
-
-#define DEFUN(lsym, csym, amin, amax, doc, data) \
- bind_function (env, lsym, \
- env->make_function (env, amin, amax, csym, doc, data))
-
- DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
- DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL);
- DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
- DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
- DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
- 1, 1, NULL, NULL);
- DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
- DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
- DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
- DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
- DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
- DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
-
-#undef DEFUN
-
- provide (env, "mod-test");
- return 0;
-}
+++ /dev/null
-;;; Test GNU Emacs modules.
-
-;; Copyright 2015-2017 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-(require 'ert)
-
-(add-to-list 'load-path
- (file-name-directory (or #$ (expand-file-name (buffer-file-name)))))
-(require 'mod-test)
-
-;;
-;; Basic tests.
-;;
-
-(ert-deftest mod-test-sum-test ()
- (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 (eq 0
- (string-match
- (concat "#<module function "
- "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
- "\\|Fmod_test_sum from .*\\)>")
- (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)
- ;; The following tests are for 32-bit build --with-wide-int.
- (should (= (mod-test-sum -1 most-positive-fixnum)
- (1- most-positive-fixnum)))
- (should (= (mod-test-sum 1 most-negative-fixnum)
- (1+ most-negative-fixnum)))
- (when (< #x1fffffff most-positive-fixnum)
- (should (= (mod-test-sum 1 #x1fffffff)
- (1+ #x1fffffff)))
- (should (= (mod-test-sum -1 #x20000000)
- #x1fffffff)))
- (should-error (mod-test-sum 1 most-positive-fixnum)
- :type 'overflow-error)
- (should-error (mod-test-sum -1 most-negative-fixnum)
- :type 'overflow-error))
-
-(ert-deftest mod-test-sum-docstring ()
- (should (string= (documentation 'mod-test-sum) "Return A + B")))
-
-;;
-;; Non-local exists (throw, signal).
-;;
-
-(ert-deftest mod-test-non-local-exit-signal-test ()
- (should-error (mod-test-signal))
- (let (debugger-args backtrace)
- (should-error
- (let ((debugger (lambda (&rest args)
- (setq debugger-args args
- backtrace (with-output-to-string (backtrace)))
- (cl-incf num-nonmacro-input-events)))
- (debug-on-signal t))
- (mod-test-signal)))
- (should (equal debugger-args '(error (error . 56))))
- (should (string-match-p
- (rx bol " internal--module-call(" (+ nonl) ?\) ?\n
- " apply(internal--module-call " (+ nonl) ?\) ?\n
- " mod-test-signal()" eol)
- backtrace))))
-
-(ert-deftest mod-test-non-local-exit-throw-test ()
- (should (equal
- (catch 'tag
- (mod-test-throw)
- (ert-fail "expected throw"))
- 65)))
-
-(ert-deftest mod-test-non-local-exit-funcall-normal ()
- (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
- 23)))
-
-(ert-deftest mod-test-non-local-exit-funcall-signal ()
- (should (equal (mod-test-non-local-exit-funcall
- (lambda () (signal 'error '(32))))
- '(signal error (32)))))
-
-(ert-deftest mod-test-non-local-exit-funcall-throw ()
- (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
- '(throw tag 32))))
-
-;;
-;; String tests.
-;;
-
-(defun multiply-string (s n)
- (let ((res ""))
- (dotimes (i n res)
- (setq res (concat res s)))))
-
-(ert-deftest mod-test-globref-make-test ()
- (let ((mod-str (mod-test-globref-make))
- (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
- (garbage-collect) ;; XXX: not enough to really test but it's something..
- (should (string= ref-str mod-str))))
-
-(ert-deftest mod-test-string-a-to-b-test ()
- (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
-
-;;
-;; User-pointer tests.
-;;
-
-(ert-deftest mod-test-userptr-fun-test ()
- (let* ((n 42)
- (v (mod-test-userptr-make n))
- (r (mod-test-userptr-get v)))
-
- (should (eq (type-of v) 'user-ptr))
- (should (integerp r))
- (should (= r n))))
-
-;; TODO: try to test finalizer
-
-;;
-;; Vector tests.
-;;
-
-(ert-deftest mod-test-vector-test ()
- (dolist (s '(2 10 100 1000))
- (dolist (e '(42 foo "foo"))
- (let* ((v-ref (make-vector 2 e))
- (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
- (v-test (make-vector s nil)))
-
- (should (eq (mod-test-vector-fill v-test e) t))
- (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
# The actual Emacs command run in the targets below.
# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) EMACS_TEST_DIRECTORY=$(srcdir) \
+emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \
+ EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
$(GDB) "$(EMACS)" $(EMACSOPT)
.PHONY: all check
$(emacs) -l ert -l $$loadfile \
--eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG}
+ifeq (@HAVE_MODULES@, yes)
+maybe_exclude_module_tests :=
+else
+maybe_exclude_module_tests := -name emacs-module-tests.el -prune -o
+endif
+
ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
- -name "*resources" -prune -o -name "*.el" -print)
+ -name "*resources" -prune -o \
+ ${maybe_exclude_module_tests} \
+ -name "*.el" -print)
## .log files may be in a different directory for out of source builds
LOGFILES := $(patsubst %.el,%.log, \
$(patsubst $(srcdir)/%,%,$(ELFILES)))
$(foreach test,${TESTS},$(eval $(call test_template,${test})))
+ifeq (@HAVE_MODULES@, yes)
+test_module_dir := $(srcdir)/data/emacs-module
+test_module_name := mod-test@MODULES_SUFFIX@
+test_module := $(test_module_dir)/$(test_module_name)
+$(srcdir)/src/emacs-module-tests.log: $(test_module)
+$(test_module): $(srcdir)/../src/emacs-module.[ch]
+ $(MAKE) -C $(test_module_dir) $(test_module_name) SO=@MODULES_SUFFIX@
+endif
+
## Check that there is no 'automated' subdirectory, which would
## indicate an incomplete merge from an older version of Emacs where
## the tests were arranged differently.
--- /dev/null
+# Test GNU Emacs modules.
+
+# Copyright 2015-2017 Free Software Foundation, Inc.
+
+# This file is part of GNU Emacs.
+
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+ROOT = ../../..
+
+CC = gcc
+LD = gcc
+LDFLAGS =
+
+# On MS-Windows, say "make SO=.dll" to build the module
+SO = .so
+# -fPIC is a no-op on Windows, but causes a compiler warning
+ifeq ($(SO),.dll)
+CFLAGS = -std=gnu99 -ggdb3 -Wall
+else
+CFLAGS = -std=gnu99 -ggdb3 -Wall -fPIC
+endif
+
+all: mod-test$(SO)
+
+%$(SO): %.o
+ $(LD) -shared $(LDFLAGS) -o $@ $<
+
+%.o: %.c
+ $(CC) $(CFLAGS) -I$(ROOT)/src -c $<
--- /dev/null
+/* Test GNU Emacs modules.
+
+Copyright 2015-2017 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <emacs-module.h>
+
+int plugin_is_GPL_compatible;
+
+/* Always return symbol 't'. */
+static emacs_value
+Fmod_test_return_t (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ return env->intern (env, "t");
+}
+
+/* Expose simple sum function. */
+static intmax_t
+sum (intmax_t a, intmax_t b)
+{
+ return a + b;
+}
+
+static emacs_value
+Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
+{
+ assert (nargs == 2);
+
+ intmax_t a = env->extract_integer (env, args[0]);
+ intmax_t b = env->extract_integer (env, args[1]);
+
+ intmax_t r = sum (a, b);
+
+ return env->make_integer (env, r);
+}
+
+
+/* Signal '(error 56). */
+static emacs_value
+Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
+ env->non_local_exit_signal (env, env->intern (env, "error"),
+ env->make_integer (env, 56));
+ return env->intern (env, "nil");
+}
+
+
+/* Throw '(tag 65). */
+static emacs_value
+Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
+ env->non_local_exit_throw (env, env->intern (env, "tag"),
+ env->make_integer (env, 65));
+ return env->intern (env, "nil");
+}
+
+
+/* Call argument function, catch all non-local exists and return
+ either normal result or a list describing the non-local exit. */
+static emacs_value
+Fmod_test_non_local_exit_funcall (emacs_env *env, ptrdiff_t nargs,
+ emacs_value args[], void *data)
+{
+ assert (nargs == 1);
+ emacs_value result = env->funcall (env, args[0], 0, NULL);
+ emacs_value non_local_exit_symbol, non_local_exit_data;
+ enum emacs_funcall_exit code
+ = env->non_local_exit_get (env, &non_local_exit_symbol,
+ &non_local_exit_data);
+ switch (code)
+ {
+ case emacs_funcall_exit_return:
+ return result;
+ case emacs_funcall_exit_signal:
+ {
+ env->non_local_exit_clear (env);
+ emacs_value Flist = env->intern (env, "list");
+ emacs_value list_args[] = {env->intern (env, "signal"),
+ non_local_exit_symbol, non_local_exit_data};
+ return env->funcall (env, Flist, 3, list_args);
+ }
+ case emacs_funcall_exit_throw:
+ {
+ env->non_local_exit_clear (env);
+ emacs_value Flist = env->intern (env, "list");
+ emacs_value list_args[] = {env->intern (env, "throw"),
+ non_local_exit_symbol, non_local_exit_data};
+ return env->funcall (env, Flist, 3, list_args);
+ }
+ }
+
+ /* Never reached. */
+ return env->intern (env, "nil");;
+}
+
+
+/* Return a global reference. */
+static emacs_value
+Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ /* Make a big string and make it global. */
+ char str[26 * 100];
+ for (int i = 0; i < sizeof str; i++)
+ str[i] = 'a' + (i % 26);
+
+ /* We don't need to null-terminate str. */
+ emacs_value lisp_str = env->make_string (env, str, sizeof str);
+ return env->make_global_ref (env, lisp_str);
+}
+
+
+/* Return a copy of the argument string where every 'a' is replaced
+ with 'b'. */
+static emacs_value
+Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ emacs_value lisp_str = args[0];
+ ptrdiff_t size = 0;
+ char * buf = NULL;
+
+ env->copy_string_contents (env, lisp_str, buf, &size);
+ buf = malloc (size);
+ env->copy_string_contents (env, lisp_str, buf, &size);
+
+ for (ptrdiff_t i = 0; i + 1 < size; i++)
+ if (buf[i] == 'a')
+ buf[i] = 'b';
+
+ return env->make_string (env, buf, size - 1);
+}
+
+
+/* Embedded pointers in lisp objects. */
+
+/* C struct (pointer to) that will be embedded. */
+struct super_struct
+{
+ int amazing_int;
+ char large_unused_buffer[512];
+};
+
+/* Return a new user-pointer to a super_struct, with amazing_int set
+ to the passed parameter. */
+static emacs_value
+Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ struct super_struct *p = calloc (1, sizeof *p);
+ p->amazing_int = env->extract_integer (env, args[0]);
+ return env->make_user_ptr (env, free, p);
+}
+
+/* Return the amazing_int of a passed 'user-pointer to a super_struct'. */
+static emacs_value
+Fmod_test_userptr_get (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ struct super_struct *p = env->get_user_ptr (env, args[0]);
+ return env->make_integer (env, p->amazing_int);
+}
+
+
+/* Fill vector in args[0] with value in args[1]. */
+static emacs_value
+Fmod_test_vector_fill (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ emacs_value vec = args[0];
+ emacs_value val = args[1];
+ ptrdiff_t size = env->vec_size (env, vec);
+ for (ptrdiff_t i = 0; i < size; i++)
+ env->vec_set (env, vec, i, val);
+ return env->intern (env, "t");
+}
+
+
+/* Return whether all elements of vector in args[0] are 'eq' to value
+ in args[1]. */
+static emacs_value
+Fmod_test_vector_eq (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ emacs_value vec = args[0];
+ emacs_value val = args[1];
+ ptrdiff_t size = env->vec_size (env, vec);
+ for (ptrdiff_t i = 0; i < size; i++)
+ if (!env->eq (env, env->vec_get (env, vec, i), val))
+ return env->intern (env, "nil");
+ return env->intern (env, "t");
+}
+
+
+/* Lisp utilities for easier readability (simple wrappers). */
+
+/* Provide FEATURE to Emacs. */
+static void
+provide (emacs_env *env, const char *feature)
+{
+ emacs_value Qfeat = env->intern (env, feature);
+ emacs_value Qprovide = env->intern (env, "provide");
+ emacs_value args[] = { Qfeat };
+
+ env->funcall (env, Qprovide, 1, args);
+}
+
+/* Bind NAME to FUN. */
+static void
+bind_function (emacs_env *env, const char *name, emacs_value Sfun)
+{
+ emacs_value Qfset = env->intern (env, "fset");
+ emacs_value Qsym = env->intern (env, name);
+ emacs_value args[] = { Qsym, Sfun };
+
+ env->funcall (env, Qfset, 2, args);
+}
+
+/* Module init function. */
+int
+emacs_module_init (struct emacs_runtime *ert)
+{
+ emacs_env *env = ert->get_environment (ert);
+
+#define DEFUN(lsym, csym, amin, amax, doc, data) \
+ bind_function (env, lsym, \
+ env->make_function (env, amin, amax, csym, doc, data))
+
+ DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL);
+ DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
+ 1, 1, NULL, NULL);
+ DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
+ DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
+
+#undef DEFUN
+
+ provide (env, "mod-test");
+ return 0;
+}
--- /dev/null
+;;; Test GNU Emacs modules.
+
+;; Copyright 2015-2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+
+(require 'ert)
+
+(require 'mod-test
+ (expand-file-name "data/emacs-module/mod-test"
+ (getenv "EMACS_TEST_DIRECTORY")))
+
+;;
+;; Basic tests.
+;;
+
+(ert-deftest mod-test-sum-test ()
+ (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 (eq 0
+ (string-match
+ (concat "#<module function "
+ "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
+ "\\|Fmod_test_sum from .*\\)>")
+ (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)
+ ;; The following tests are for 32-bit build --with-wide-int.
+ (should (= (mod-test-sum -1 most-positive-fixnum)
+ (1- most-positive-fixnum)))
+ (should (= (mod-test-sum 1 most-negative-fixnum)
+ (1+ most-negative-fixnum)))
+ (when (< #x1fffffff most-positive-fixnum)
+ (should (= (mod-test-sum 1 #x1fffffff)
+ (1+ #x1fffffff)))
+ (should (= (mod-test-sum -1 #x20000000)
+ #x1fffffff)))
+ (should-error (mod-test-sum 1 most-positive-fixnum)
+ :type 'overflow-error)
+ (should-error (mod-test-sum -1 most-negative-fixnum)
+ :type 'overflow-error))
+
+(ert-deftest mod-test-sum-docstring ()
+ (should (string= (documentation 'mod-test-sum) "Return A + B")))
+
+;;
+;; Non-local exists (throw, signal).
+;;
+
+(ert-deftest mod-test-non-local-exit-signal-test ()
+ (should-error (mod-test-signal))
+ (let (debugger-args backtrace)
+ (should-error
+ (let ((debugger (lambda (&rest args)
+ (setq debugger-args args
+ backtrace (with-output-to-string (backtrace)))
+ (cl-incf num-nonmacro-input-events)))
+ (debug-on-signal t))
+ (mod-test-signal)))
+ (should (equal debugger-args '(error (error . 56))))
+ (should (string-match-p
+ (rx bol " internal--module-call(" (+ nonl) ?\) ?\n
+ " apply(internal--module-call " (+ nonl) ?\) ?\n
+ " mod-test-signal()" eol)
+ backtrace))))
+
+(ert-deftest mod-test-non-local-exit-throw-test ()
+ (should (equal
+ (catch 'tag
+ (mod-test-throw)
+ (ert-fail "expected throw"))
+ 65)))
+
+(ert-deftest mod-test-non-local-exit-funcall-normal ()
+ (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
+ 23)))
+
+(ert-deftest mod-test-non-local-exit-funcall-signal ()
+ (should (equal (mod-test-non-local-exit-funcall
+ (lambda () (signal 'error '(32))))
+ '(signal error (32)))))
+
+(ert-deftest mod-test-non-local-exit-funcall-throw ()
+ (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
+ '(throw tag 32))))
+
+;;
+;; String tests.
+;;
+
+(defun multiply-string (s n)
+ (let ((res ""))
+ (dotimes (i n res)
+ (setq res (concat res s)))))
+
+(ert-deftest mod-test-globref-make-test ()
+ (let ((mod-str (mod-test-globref-make))
+ (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
+ (garbage-collect) ;; XXX: not enough to really test but it's something..
+ (should (string= ref-str mod-str))))
+
+(ert-deftest mod-test-string-a-to-b-test ()
+ (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
+
+;;
+;; User-pointer tests.
+;;
+
+(ert-deftest mod-test-userptr-fun-test ()
+ (let* ((n 42)
+ (v (mod-test-userptr-make n))
+ (r (mod-test-userptr-get v)))
+
+ (should (eq (type-of v) 'user-ptr))
+ (should (integerp r))
+ (should (= r n))))
+
+;; TODO: try to test finalizer
+
+;;
+;; Vector tests.
+;;
+
+(ert-deftest mod-test-vector-test ()
+ (dolist (s '(2 10 100 1000))
+ (dolist (e '(42 foo "foo"))
+ (let* ((v-ref (make-vector 2 e))
+ (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
+ (v-test (make-vector s nil)))
+
+ (should (eq (mod-test-vector-fill v-test e) t))
+ (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
projects / emacs.git / commitdiff