diff options
| author | Philipp Stephani | 2017-04-22 15:41:39 +0200 |
|---|---|---|
| committer | Philipp Stephani | 2017-04-29 14:38:53 +0200 |
| commit | bfc0f610bac3f97930941e9a66cbcd11cd382167 (patch) | |
| tree | 79859d074900b59a51020efc54df3385cc33a80d /modules | |
| parent | 6a3f331565322b43c41fdf67c6d2dc3feac8cc1c (diff) | |
| download | emacs-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/Makefile | 45 | ||||
| -rw-r--r-- | modules/mod-test/mod-test.c | 268 | ||||
| -rw-r--r-- | modules/mod-test/test.el | 148 |
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 | |||
| 20 | ROOT = ../.. | ||
| 21 | EMACS = $(ROOT)/src/emacs | ||
| 22 | |||
| 23 | CC = gcc | ||
| 24 | LD = gcc | ||
| 25 | LDFLAGS = | ||
| 26 | |||
| 27 | # On MS-Windows, say "make SO=dll" to build the module | ||
| 28 | SO = so | ||
| 29 | # -fPIC is a no-op on Windows, but causes a compiler warning | ||
| 30 | ifeq ($(SO),dll) | ||
| 31 | CFLAGS = -std=gnu99 -ggdb3 -Wall | ||
| 32 | else | ||
| 33 | CFLAGS = -std=gnu99 -ggdb3 -Wall -fPIC | ||
| 34 | endif | ||
| 35 | |||
| 36 | all: mod-test.$(SO) | ||
| 37 | |||
| 38 | %.$(SO): %.o | ||
| 39 | $(LD) -shared $(LDFLAGS) -o $@ $< | ||
| 40 | |||
| 41 | %.o: %.c | ||
| 42 | $(CC) $(CFLAGS) -I$(ROOT)/src -c $< | ||
| 43 | |||
| 44 | check: | ||
| 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 | |||
| 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 (at | ||
| 10 | 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 | #include <assert.h> | ||
| 21 | #include <stdio.h> | ||
| 22 | #include <stdlib.h> | ||
| 23 | #include <emacs-module.h> | ||
| 24 | |||
| 25 | int plugin_is_GPL_compatible; | ||
| 26 | |||
| 27 | /* Always return symbol 't'. */ | ||
| 28 | static emacs_value | ||
| 29 | Fmod_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. */ | ||
| 36 | static intmax_t | ||
| 37 | sum (intmax_t a, intmax_t b) | ||
| 38 | { | ||
| 39 | return a + b; | ||
| 40 | } | ||
| 41 | |||
| 42 | static emacs_value | ||
| 43 | Fmod_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). */ | ||
| 57 | static emacs_value | ||
| 58 | Fmod_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). */ | ||
| 69 | static emacs_value | ||
| 70 | Fmod_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. */ | ||
| 82 | static emacs_value | ||
| 83 | Fmod_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. */ | ||
| 120 | static emacs_value | ||
| 121 | Fmod_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'. */ | ||
| 137 | static emacs_value | ||
| 138 | Fmod_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. */ | ||
| 160 | struct 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. */ | ||
| 168 | static emacs_value | ||
| 169 | Fmod_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'. */ | ||
| 178 | static emacs_value | ||
| 179 | Fmod_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]. */ | ||
| 188 | static emacs_value | ||
| 189 | Fmod_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]. */ | ||
| 203 | static emacs_value | ||
| 204 | Fmod_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. */ | ||
| 220 | static void | ||
| 221 | provide (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. */ | ||
| 231 | static void | ||
| 232 | bind_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. */ | ||
| 242 | int | ||
| 243 | emacs_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)))))) | ||