From: Philipp Stephani Date: Sat, 22 Apr 2017 13:41:39 +0000 (+0200) Subject: Integrate module test with normal test suite X-Git-Tag: emacs-26.0.90~521^2~519 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bfc0f610bac3f97930941e9a66cbcd11cd382167;p=emacs.git Integrate module test with normal test suite * test/Makefile.in (ELFILES): Exclude module test if modules aren't configured. (EMACS_TEST_DIRECTORY): Expand test directory so that it's set correctly even if Emacs changes the current directory. ($(srcdir)/src/emacs-module-tests.log) ($(test_module)): Proper dependency tracking for test module. * test/data/emacs-module/Makefile (ROOT): Adapt to new location. Remove 'check' target and EMACS variable, which are no longer necessary. (SO): Change to include period. * test/src/emacs-module-tests.el (mod-test): Use EMACS_TEST_DIRECTORY environment variable to reliably find test data. * configure.ac (HAVE_MODULES, MODULES_SUFFIX): Add necessary substitutions. --- diff --git a/configure.ac b/configure.ac index bd8f7650cc4..f3c53d7a19d 100644 --- a/configure.ac +++ b/configure.ac @@ -3476,6 +3476,8 @@ if test "${HAVE_MODULES}" = yes; then 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 diff --git a/modules/mod-test/Makefile b/modules/mod-test/Makefile deleted file mode 100644 index 27ae2ae3c2c..00000000000 --- a/modules/mod-test/Makefile +++ /dev/null @@ -1,45 +0,0 @@ -# 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 . - -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 diff --git a/modules/mod-test/mod-test.c b/modules/mod-test/mod-test.c deleted file mode 100644 index 50be8620bd6..00000000000 --- a/modules/mod-test/mod-test.c +++ /dev/null @@ -1,268 +0,0 @@ -/* 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 . */ - -#include -#include -#include -#include - -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; -} diff --git a/modules/mod-test/test.el b/modules/mod-test/test.el deleted file mode 100644 index caa807d3005..00000000000 --- a/modules/mod-test/test.el +++ /dev/null @@ -1,148 +0,0 @@ -;;; 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 . */ - -(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 "#") - (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)))))) diff --git a/test/Makefile.in b/test/Makefile.in index a1b772de216..03ae32e3a62 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -63,7 +63,8 @@ TEST_LOCALE = C # 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 @@ -124,8 +125,16 @@ endif $(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))) @@ -159,6 +168,15 @@ endef $(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. diff --git a/test/data/emacs-module/Makefile b/test/data/emacs-module/Makefile new file mode 100644 index 00000000000..db5e1b68088 --- /dev/null +++ b/test/data/emacs-module/Makefile @@ -0,0 +1,41 @@ +# 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 . + +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 $< diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c new file mode 100644 index 00000000000..50be8620bd6 --- /dev/null +++ b/test/data/emacs-module/mod-test.c @@ -0,0 +1,268 @@ +/* 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 . */ + +#include +#include +#include +#include + +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; +} diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el new file mode 100644 index 00000000000..93e85ae22db --- /dev/null +++ b/test/src/emacs-module-tests.el @@ -0,0 +1,148 @@ +;;; 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 . */ + +(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 "#") + (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))))))