aboutsummaryrefslogtreecommitdiffstats
path: root/modules
diff options
context:
space:
mode:
authorPhilipp Stephani2017-04-22 15:41:39 +0200
committerPhilipp Stephani2017-04-29 14:38:53 +0200
commitbfc0f610bac3f97930941e9a66cbcd11cd382167 (patch)
tree79859d074900b59a51020efc54df3385cc33a80d /modules
parent6a3f331565322b43c41fdf67c6d2dc3feac8cc1c (diff)
downloademacs-bfc0f610bac3f97930941e9a66cbcd11cd382167.tar.gz
emacs-bfc0f610bac3f97930941e9a66cbcd11cd382167.zip
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.
Diffstat (limited to 'modules')
-rw-r--r--modules/mod-test/Makefile45
-rw-r--r--modules/mod-test/mod-test.c268
-rw-r--r--modules/mod-test/test.el148
3 files changed, 0 insertions, 461 deletions
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 @@
1# Test GNU Emacs modules.
2
3# Copyright 2015-2017 Free Software Foundation, Inc.
4
5# This file is part of GNU Emacs.
6
7# GNU Emacs is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11
12# GNU Emacs is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16
17# You should have received a copy of the GNU General Public License
18# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19
20ROOT = ../..
21EMACS = $(ROOT)/src/emacs
22
23CC = gcc
24LD = gcc
25LDFLAGS =
26
27# On MS-Windows, say "make SO=dll" to build the module
28SO = so
29# -fPIC is a no-op on Windows, but causes a compiler warning
30ifeq ($(SO),dll)
31CFLAGS = -std=gnu99 -ggdb3 -Wall
32else
33CFLAGS = -std=gnu99 -ggdb3 -Wall -fPIC
34endif
35
36all: mod-test.$(SO)
37
38%.$(SO): %.o
39 $(LD) -shared $(LDFLAGS) -o $@ $<
40
41%.o: %.c
42 $(CC) $(CFLAGS) -I$(ROOT)/src -c $<
43
44check:
45 $(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 @@
1/* Test GNU Emacs modules.
2
3Copyright 2015-2017 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or (at
10your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20#include <assert.h>
21#include <stdio.h>
22#include <stdlib.h>
23#include <emacs-module.h>
24
25int plugin_is_GPL_compatible;
26
27/* Always return symbol 't'. */
28static emacs_value
29Fmod_test_return_t (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
30 void *data)
31{
32 return env->intern (env, "t");
33}
34
35/* Expose simple sum function. */
36static intmax_t
37sum (intmax_t a, intmax_t b)
38{
39 return a + b;
40}
41
42static emacs_value
43Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
44{
45 assert (nargs == 2);
46
47 intmax_t a = env->extract_integer (env, args[0]);
48 intmax_t b = env->extract_integer (env, args[1]);
49
50 intmax_t r = sum (a, b);
51
52 return env->make_integer (env, r);
53}
54
55
56/* Signal '(error 56). */
57static emacs_value
58Fmod_test_signal (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
59 void *data)
60{
61 assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
62 env->non_local_exit_signal (env, env->intern (env, "error"),
63 env->make_integer (env, 56));
64 return env->intern (env, "nil");
65}
66
67
68/* Throw '(tag 65). */
69static emacs_value
70Fmod_test_throw (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
71 void *data)
72{
73 assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
74 env->non_local_exit_throw (env, env->intern (env, "tag"),
75 env->make_integer (env, 65));
76 return env->intern (env, "nil");
77}
78
79
80/* Call argument function, catch all non-local exists and return
81 either normal result or a list describing the non-local exit. */
82static emacs_value
83Fmod_test_non_local_exit_funcall (emacs_env *env, ptrdiff_t nargs,
84 emacs_value args[], void *data)
85{
86 assert (nargs == 1);
87 emacs_value result = env->funcall (env, args[0], 0, NULL);
88 emacs_value non_local_exit_symbol, non_local_exit_data;
89 enum emacs_funcall_exit code
90 = env->non_local_exit_get (env, &non_local_exit_symbol,
91 &non_local_exit_data);
92 switch (code)
93 {
94 case emacs_funcall_exit_return:
95 return result;
96 case emacs_funcall_exit_signal:
97 {
98 env->non_local_exit_clear (env);
99 emacs_value Flist = env->intern (env, "list");
100 emacs_value list_args[] = {env->intern (env, "signal"),
101 non_local_exit_symbol, non_local_exit_data};
102 return env->funcall (env, Flist, 3, list_args);
103 }
104 case emacs_funcall_exit_throw:
105 {
106 env->non_local_exit_clear (env);
107 emacs_value Flist = env->intern (env, "list");
108 emacs_value list_args[] = {env->intern (env, "throw"),
109 non_local_exit_symbol, non_local_exit_data};
110 return env->funcall (env, Flist, 3, list_args);
111 }
112 }
113
114 /* Never reached. */
115 return env->intern (env, "nil");;
116}
117
118
119/* Return a global reference. */
120static emacs_value
121Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
122 void *data)
123{
124 /* Make a big string and make it global. */
125 char str[26 * 100];
126 for (int i = 0; i < sizeof str; i++)
127 str[i] = 'a' + (i % 26);
128
129 /* We don't need to null-terminate str. */
130 emacs_value lisp_str = env->make_string (env, str, sizeof str);
131 return env->make_global_ref (env, lisp_str);
132}
133
134
135/* Return a copy of the argument string where every 'a' is replaced
136 with 'b'. */
137static emacs_value
138Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
139 void *data)
140{
141 emacs_value lisp_str = args[0];
142 ptrdiff_t size = 0;
143 char * buf = NULL;
144
145 env->copy_string_contents (env, lisp_str, buf, &size);
146 buf = malloc (size);
147 env->copy_string_contents (env, lisp_str, buf, &size);
148
149 for (ptrdiff_t i = 0; i + 1 < size; i++)
150 if (buf[i] == 'a')
151 buf[i] = 'b';
152
153 return env->make_string (env, buf, size - 1);
154}
155
156
157/* Embedded pointers in lisp objects. */
158
159/* C struct (pointer to) that will be embedded. */
160struct super_struct
161{
162 int amazing_int;
163 char large_unused_buffer[512];
164};
165
166/* Return a new user-pointer to a super_struct, with amazing_int set
167 to the passed parameter. */
168static emacs_value
169Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
170 void *data)
171{
172 struct super_struct *p = calloc (1, sizeof *p);
173 p->amazing_int = env->extract_integer (env, args[0]);
174 return env->make_user_ptr (env, free, p);
175}
176
177/* Return the amazing_int of a passed 'user-pointer to a super_struct'. */
178static emacs_value
179Fmod_test_userptr_get (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
180 void *data)
181{
182 struct super_struct *p = env->get_user_ptr (env, args[0]);
183 return env->make_integer (env, p->amazing_int);
184}
185
186
187/* Fill vector in args[0] with value in args[1]. */
188static emacs_value
189Fmod_test_vector_fill (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
190 void *data)
191{
192 emacs_value vec = args[0];
193 emacs_value val = args[1];
194 ptrdiff_t size = env->vec_size (env, vec);
195 for (ptrdiff_t i = 0; i < size; i++)
196 env->vec_set (env, vec, i, val);
197 return env->intern (env, "t");
198}
199
200
201/* Return whether all elements of vector in args[0] are 'eq' to value
202 in args[1]. */
203static emacs_value
204Fmod_test_vector_eq (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
205 void *data)
206{
207 emacs_value vec = args[0];
208 emacs_value val = args[1];
209 ptrdiff_t size = env->vec_size (env, vec);
210 for (ptrdiff_t i = 0; i < size; i++)
211 if (!env->eq (env, env->vec_get (env, vec, i), val))
212 return env->intern (env, "nil");
213 return env->intern (env, "t");
214}
215
216
217/* Lisp utilities for easier readability (simple wrappers). */
218
219/* Provide FEATURE to Emacs. */
220static void
221provide (emacs_env *env, const char *feature)
222{
223 emacs_value Qfeat = env->intern (env, feature);
224 emacs_value Qprovide = env->intern (env, "provide");
225 emacs_value args[] = { Qfeat };
226
227 env->funcall (env, Qprovide, 1, args);
228}
229
230/* Bind NAME to FUN. */
231static void
232bind_function (emacs_env *env, const char *name, emacs_value Sfun)
233{
234 emacs_value Qfset = env->intern (env, "fset");
235 emacs_value Qsym = env->intern (env, name);
236 emacs_value args[] = { Qsym, Sfun };
237
238 env->funcall (env, Qfset, 2, args);
239}
240
241/* Module init function. */
242int
243emacs_module_init (struct emacs_runtime *ert)
244{
245 emacs_env *env = ert->get_environment (ert);
246
247#define DEFUN(lsym, csym, amin, amax, doc, data) \
248 bind_function (env, lsym, \
249 env->make_function (env, amin, amax, csym, doc, data))
250
251 DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
252 DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL);
253 DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
254 DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
255 DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
256 1, 1, NULL, NULL);
257 DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
258 DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
259 DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
260 DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
261 DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
262 DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
263
264#undef DEFUN
265
266 provide (env, "mod-test");
267 return 0;
268}
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 @@
1;;; Test GNU Emacs modules.
2
3;; Copyright 2015-2017 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20(require 'ert)
21
22(add-to-list 'load-path
23 (file-name-directory (or #$ (expand-file-name (buffer-file-name)))))
24(require 'mod-test)
25
26;;
27;; Basic tests.
28;;
29
30(ert-deftest mod-test-sum-test ()
31 (should (= (mod-test-sum 1 2) 3))
32 (let ((descr (should-error (mod-test-sum 1 2 3))))
33 (should (eq (car descr) 'wrong-number-of-arguments))
34 (should (stringp (nth 1 descr)))
35 (should (eq 0
36 (string-match
37 (concat "#<module function "
38 "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
39 "\\|Fmod_test_sum from .*\\)>")
40 (nth 1 descr))))
41 (should (= (nth 2 descr) 3)))
42 (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
43 (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
44 ;; The following tests are for 32-bit build --with-wide-int.
45 (should (= (mod-test-sum -1 most-positive-fixnum)
46 (1- most-positive-fixnum)))
47 (should (= (mod-test-sum 1 most-negative-fixnum)
48 (1+ most-negative-fixnum)))
49 (when (< #x1fffffff most-positive-fixnum)
50 (should (= (mod-test-sum 1 #x1fffffff)
51 (1+ #x1fffffff)))
52 (should (= (mod-test-sum -1 #x20000000)
53 #x1fffffff)))
54 (should-error (mod-test-sum 1 most-positive-fixnum)
55 :type 'overflow-error)
56 (should-error (mod-test-sum -1 most-negative-fixnum)
57 :type 'overflow-error))
58
59(ert-deftest mod-test-sum-docstring ()
60 (should (string= (documentation 'mod-test-sum) "Return A + B")))
61
62;;
63;; Non-local exists (throw, signal).
64;;
65
66(ert-deftest mod-test-non-local-exit-signal-test ()
67 (should-error (mod-test-signal))
68 (let (debugger-args backtrace)
69 (should-error
70 (let ((debugger (lambda (&rest args)
71 (setq debugger-args args
72 backtrace (with-output-to-string (backtrace)))
73 (cl-incf num-nonmacro-input-events)))
74 (debug-on-signal t))
75 (mod-test-signal)))
76 (should (equal debugger-args '(error (error . 56))))
77 (should (string-match-p
78 (rx bol " internal--module-call(" (+ nonl) ?\) ?\n
79 " apply(internal--module-call " (+ nonl) ?\) ?\n
80 " mod-test-signal()" eol)
81 backtrace))))
82
83(ert-deftest mod-test-non-local-exit-throw-test ()
84 (should (equal
85 (catch 'tag
86 (mod-test-throw)
87 (ert-fail "expected throw"))
88 65)))
89
90(ert-deftest mod-test-non-local-exit-funcall-normal ()
91 (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
92 23)))
93
94(ert-deftest mod-test-non-local-exit-funcall-signal ()
95 (should (equal (mod-test-non-local-exit-funcall
96 (lambda () (signal 'error '(32))))
97 '(signal error (32)))))
98
99(ert-deftest mod-test-non-local-exit-funcall-throw ()
100 (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
101 '(throw tag 32))))
102
103;;
104;; String tests.
105;;
106
107(defun multiply-string (s n)
108 (let ((res ""))
109 (dotimes (i n res)
110 (setq res (concat res s)))))
111
112(ert-deftest mod-test-globref-make-test ()
113 (let ((mod-str (mod-test-globref-make))
114 (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
115 (garbage-collect) ;; XXX: not enough to really test but it's something..
116 (should (string= ref-str mod-str))))
117
118(ert-deftest mod-test-string-a-to-b-test ()
119 (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
120
121;;
122;; User-pointer tests.
123;;
124
125(ert-deftest mod-test-userptr-fun-test ()
126 (let* ((n 42)
127 (v (mod-test-userptr-make n))
128 (r (mod-test-userptr-get v)))
129
130 (should (eq (type-of v) 'user-ptr))
131 (should (integerp r))
132 (should (= r n))))
133
134;; TODO: try to test finalizer
135
136;;
137;; Vector tests.
138;;
139
140(ert-deftest mod-test-vector-test ()
141 (dolist (s '(2 10 100 1000))
142 (dolist (e '(42 foo "foo"))
143 (let* ((v-ref (make-vector 2 e))
144 (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
145 (v-test (make-vector s nil)))
146
147 (should (eq (mod-test-vector-fill v-test e) t))
148 (should (eq (mod-test-vector-eq v-test e) eq-ref))))))