From: Stefan Kangas Date: Fri, 23 Oct 2020 14:29:46 +0000 (+0200) Subject: Move some test data to follow our conventions X-Git-Tag: emacs-28.0.90~5464 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=49bc8586b7abc8e1e36027ca5eec0d0488a27474;p=emacs.git Move some test data to follow our conventions * test/data/emacs-module/mod-test.c: Move from here... * test/src/emacs-module-resources/mod-test.c: ...to here. * test/src/emacs-module-tests.el (ert-x): Require. (mod-test-file, module/describe-function-1): * test/Makefile.in (test_module_dir): Adjust for move. * test/data/files-bug18141.el.gz: Move from here... * test/lisp/files-resources/files-bug18141.el.gz: ... to here. * test/lisp/files-tests.el (ert-x): Require. (files-test-bug-18141-file): Use ert-resource-file. * test/data/mailcap/mime.types: Move from here... * test/lisp/net/mailcap-resources/mime.types: ...to here. * test/lisp/net/mailcap-tests.el (ert-x): Require. (mailcap-tests-path): Use ert-resource-file. * test/data/somelib.el: * test/data/somelib2.el: Move from here... * test/src/lread-resources/somelib.el: * test/src/lread-resources/somelib2.el: ...to here. * test/src/lread-tests.el (ert, ert-x): Require. (lread-test-bug26837): Use ert-resource-directory. * test/data/syntax-comments.txt: Move from here.... * test/src/syntax-resources/syntax-comments.txt: ...to here. * test/src/syntax-tests.el (ert-x): Require. (syntax-comments, syntax-br-comments, syntax-pps-comments): Use ert-resource-file. * test/data/xref/file1.txt: * test/data/xref/file2.txt: Move from here... * test/lisp/progmodes/xref-resources/file1.txt: * test/lisp/progmodes/xref-resources/file2.txt: ...to here. * test/lisp/progmodes/xref-tests.el (ert, ert-x): Require. (xref-tests-data-dir): Use ert-resource-directory. --- diff --git a/test/Makefile.in b/test/Makefile.in index 9974eb54b03..67d203df297 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -132,7 +132,7 @@ emacs = EMACSLOADPATH= \ # exists, or writing to ~/.bzr.log when running bzr commands). TEST_HOME = /nonexistent -test_module_dir := data/emacs-module +test_module_dir := src/emacs-module-resources .PHONY: all check diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c deleted file mode 100644 index 258a679b207..00000000000 --- a/test/data/emacs-module/mod-test.c +++ /dev/null @@ -1,801 +0,0 @@ -/* Test GNU Emacs modules. - -Copyright 2015-2020 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 "config.h" - -#undef NDEBUG -#include - -#include -#include -#include -#include -#include -#include -#include - -#ifdef WINDOWSNT -/* Cannot include because of the local header by the same - name, sigh. */ -uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); -# if !defined __x86_64__ -# define ALIGN_STACK __attribute__((force_align_arg_pointer)) -# endif -# include /* for Sleep */ -#else /* !WINDOWSNT */ -# include -# include -#endif - -#include -#include - -#include "timespec.h" - -int plugin_is_GPL_compatible; - -#if INTPTR_MAX <= 0 -# error "INTPTR_MAX misconfigured" -#elif INTPTR_MAX <= INT_MAX || INTPTR_MAX <= LONG_MAX -# define pT "ld" -# define pZ "lu" -# define T_TYPE long -# define Z_TYPE unsigned long -#elif INTPTR_MAX <= INT64_MAX -# ifdef __MINGW32__ -# define pT "lld" -# define pZ "llu" -# define T_TYPE long long -# define Z_TYPE unsigned long long -# else -# define pT "ld" -# define pZ "lu" -# define T_TYPE long -# define Z_TYPE unsigned long -# endif -#else -# error "INTPTR_MAX too large" -#endif - -/* Smoke test to verify that EMACS_LIMB_MAX is defined. */ -_Static_assert (0 < EMACS_LIMB_MAX, "EMACS_LIMB_MAX missing or incorrect"); - -/* 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); - assert ((uintptr_t) data == 0x1234); - - 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 NULL; -} - - -/* 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 NULL; -} - - -/* 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); -} - -/* Create a few global references from arguments and free them. */ -static emacs_value -Fmod_test_globref_free (emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) -{ - emacs_value refs[10]; - for (int i = 0; i < 10; i++) - { - refs[i] = env->make_global_ref (env, args[i % nargs]); - } - for (int i = 0; i < 10; i++) - { - env->free_global_ref (env, refs[i]); - } - return env->intern (env, "ok"); -} - -/* Treat a local reference as global and free it. Module assertions - should detect this case even if a global reference representing the - same object also exists. */ - -static emacs_value -Fmod_test_globref_invalid_free (emacs_env *env, ptrdiff_t nargs, - emacs_value *args, void *data) -{ - emacs_value local = env->make_integer (env, 9876); - env->make_global_ref (env, local); - env->free_global_ref (env, local); /* Not allowed. */ - return env->intern (env, "nil"); -} - -/* Allocate and free global references in a different order. */ - -static emacs_value -Fmod_test_globref_reordered (emacs_env *env, ptrdiff_t nargs, - emacs_value *args, void *data) -{ - emacs_value booleans[2] = { - env->intern (env, "nil"), - env->intern (env, "t"), - }; - emacs_value local = env->intern (env, "foo"); - emacs_value globals[4] = { - env->make_global_ref (env, local), - env->make_global_ref (env, local), - env->make_global_ref (env, env->intern (env, "foo")), - env->make_global_ref (env, env->intern (env, "bar")), - }; - emacs_value elements[4]; - for (int i = 0; i < 4; ++i) - elements[i] = booleans[env->eq (env, globals[i], local)]; - emacs_value ret = env->funcall (env, env->intern (env, "list"), 4, elements); - env->free_global_ref (env, globals[2]); - env->free_global_ref (env, globals[1]); - env->free_global_ref (env, globals[3]); - env->free_global_ref (env, globals[0]); - return ret; -} - - -/* 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'; - - emacs_value ret = env->make_string (env, buf, size - 1); - free (buf); - return ret; -} - - -/* Return a unibyte string. */ -static emacs_value -Fmod_test_return_unibyte (emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) -{ - const char *string = "foo\x00zot"; - return env->make_unibyte_string (env, string, 7); -} - - -/* 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"); -} - -static emacs_value invalid_stored_value; - -/* The next two functions perform a possibly-invalid operation: they - store a value in a static variable and load it. This causes - undefined behavior if the environment that the value was created - from is no longer live. The module assertions check for this - error. */ - -static emacs_value -Fmod_test_invalid_store (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - return invalid_stored_value = env->make_integer (env, 123); -} - -static emacs_value -Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - return invalid_stored_value; -} - -/* The next function works in conjunction with the two previous ones. - It stows away a copy of the object created by - `Fmod_test_invalid_store' in a global reference. Module assertions - should still detect the invalid load of the local reference. */ - -static emacs_value global_copy_of_invalid_stored_value; - -static emacs_value -Fmod_test_invalid_store_copy (emacs_env *env, ptrdiff_t nargs, - emacs_value *args, void *data) -{ - emacs_value local = Fmod_test_invalid_store (env, 0, NULL, NULL); - return global_copy_of_invalid_stored_value - = env->make_global_ref (env, local); -} - -/* An invalid finalizer: Finalizers are run during garbage collection, - where Lisp code can't be executed. -module-assertions tests for - this case. */ - -static emacs_env *current_env; - -static void -invalid_finalizer (void *ptr) -{ - current_env->intern (current_env, "nil"); -} - -static emacs_value -Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - current_env = env; - env->make_user_ptr (env, invalid_finalizer, NULL); - return env->intern (env, "nil"); -} - -static void -signal_system_error (emacs_env *env, int error, const char *function) -{ - const char *message = strerror (error); - emacs_value message_value = env->make_string (env, message, strlen (message)); - emacs_value symbol = env->intern (env, "file-error"); - emacs_value elements[2] - = {env->make_string (env, function, strlen (function)), message_value}; - emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); - env->non_local_exit_signal (env, symbol, data); -} - -static void -signal_errno (emacs_env *env, const char *function) -{ - signal_system_error (env, errno, function); -} - -/* A long-running operation that occasionally calls `should_quit' or - `process_input'. */ - -static emacs_value -Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (nargs == 2); - const struct timespec until = env->extract_time (env, args[0]); - if (env->non_local_exit_check (env)) - return NULL; - const bool process_input = env->is_not_nil (env, args[1]); - const struct timespec amount = make_timespec(0, 10000000); - while (true) - { - const struct timespec now = current_timespec (); - if (timespec_cmp (now, until) >= 0) - break; - if (nanosleep (&amount, NULL) && errno != EINTR) - { - signal_errno (env, "nanosleep"); - return NULL; - } - if ((process_input - && env->process_input (env) == emacs_process_input_quit) - || env->should_quit (env)) - return NULL; - } - return env->intern (env, "finished"); -} - -static emacs_value -Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (nargs == 1); - struct timespec time = env->extract_time (env, args[0]); - assert (time.tv_nsec >= 0); - assert (time.tv_nsec < 2000000000); /* possible leap second */ - time.tv_nsec++; - return env->make_time (env, time); -} - -static void -signal_error (emacs_env *env, const char *message) -{ - emacs_value data = env->make_string (env, message, strlen (message)); - env->non_local_exit_signal (env, env->intern (env, "error"), - env->funcall (env, env->intern (env, "list"), 1, - &data)); -} - -static void -memory_full (emacs_env *env) -{ - signal_error (env, "Memory exhausted"); -} - -enum -{ - max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX) - / sizeof (emacs_limb_t)) -}; - -static bool -extract_big_integer (emacs_env *env, emacs_value arg, mpz_t result) -{ - int sign; - ptrdiff_t count; - bool success = env->extract_big_integer (env, arg, &sign, &count, NULL); - if (!success) - return false; - if (sign == 0) - { - mpz_set_ui (result, 0); - return true; - } - enum { order = -1, size = sizeof (emacs_limb_t), endian = 0, nails = 0 }; - assert (0 < count && count <= max_count); - emacs_limb_t *magnitude = malloc (count * size); - if (magnitude == NULL) - { - memory_full (env); - return false; - } - success = env->extract_big_integer (env, arg, NULL, &count, magnitude); - assert (success); - mpz_import (result, count, order, size, endian, nails, magnitude); - free (magnitude); - if (sign < 0) - mpz_neg (result, result); - return true; -} - -static emacs_value -make_big_integer (emacs_env *env, const mpz_t value) -{ - if (mpz_sgn (value) == 0) - return env->make_integer (env, 0); - /* See - https://gmplib.org/manual/Integer-Import-and-Export.html#index-Export. */ - enum - { - order = -1, - size = sizeof (emacs_limb_t), - endian = 0, - nails = 0, - numb = 8 * size - nails - }; - size_t count = (mpz_sizeinbase (value, 2) + numb - 1) / numb; - if (max_count < count) - { - memory_full (env); - return NULL; - } - emacs_limb_t *magnitude = malloc (count * size); - if (magnitude == NULL) - { - memory_full (env); - return NULL; - } - size_t written; - mpz_export (magnitude, &written, order, size, endian, nails, value); - assert (written == count); - assert (count <= PTRDIFF_MAX); - emacs_value result = env->make_big_integer (env, mpz_sgn (value), - (ptrdiff_t) count, magnitude); - free (magnitude); - return result; -} - -static emacs_value -Fmod_test_nanoseconds (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) { - assert (nargs == 1); - struct timespec time = env->extract_time (env, args[0]); - mpz_t nanoseconds; - assert (LONG_MIN <= time.tv_sec && time.tv_sec <= LONG_MAX); - mpz_init_set_si (nanoseconds, time.tv_sec); -#ifdef __MINGW32__ - _Static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); -#else - static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); -#endif - mpz_mul_ui (nanoseconds, nanoseconds, 1000000000); - assert (0 <= time.tv_nsec && time.tv_nsec <= ULONG_MAX); - mpz_add_ui (nanoseconds, nanoseconds, time.tv_nsec); - emacs_value result = make_big_integer (env, nanoseconds); - mpz_clear (nanoseconds); - return result; -} - -static emacs_value -Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (nargs == 1); - emacs_value arg = args[0]; - mpz_t value; - mpz_init (value); - extract_big_integer (env, arg, value); - mpz_mul_ui (value, value, 2); - emacs_value result = make_big_integer (env, value); - mpz_clear (value); - return result; -} - -static int function_data; -static int finalizer_calls_with_correct_data; -static int finalizer_calls_with_incorrect_data; - -static void -finalizer (void *data) -{ - if (data == &function_data) - ++finalizer_calls_with_correct_data; - else - ++finalizer_calls_with_incorrect_data; -} - -static emacs_value -Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs, - emacs_value *args, void *data) -{ - emacs_value fun - = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data); - env->set_function_finalizer (env, fun, finalizer); - if (env->get_function_finalizer (env, fun) != finalizer) - signal_error (env, "Invalid finalizer"); - return fun; -} - -static emacs_value -Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, - emacs_value *args, void *data) -{ - emacs_value Flist = env->intern (env, "list"); - emacs_value list_args[] - = {env->make_integer (env, finalizer_calls_with_correct_data), - env->make_integer (env, finalizer_calls_with_incorrect_data)}; - return env->funcall (env, Flist, 2, list_args); -} - -static void -sleep_for_half_second (void) -{ - /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */ -#ifdef WINDOWSNT - Sleep (500); -#else - const struct timespec sleep = {0, 500000000}; - if (nanosleep (&sleep, NULL) != 0) - perror ("nanosleep"); -#endif -} - -#ifdef WINDOWSNT -static void ALIGN_STACK -#else -static void * -#endif -write_to_pipe (void *arg) -{ - /* We sleep a bit to test that writing to a pipe is indeed possible - if no environment is active. */ - sleep_for_half_second (); - FILE *stream = arg; - /* The string below should be identical to the one we compare with - in emacs-module-tests.el:module/async-pipe. */ - if (fputs ("data from thread", stream) < 0) - perror ("fputs"); - if (fclose (stream) != 0) - perror ("close"); -#ifndef WINDOWSNT - return NULL; -#endif -} - -static emacs_value -Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (nargs == 1); - int fd = env->open_channel (env, args[0]); - if (env->non_local_exit_check (env) != emacs_funcall_exit_return) - return NULL; - FILE *stream = fdopen (fd, "w"); - if (stream == NULL) - { - signal_errno (env, "fdopen"); - return NULL; - } -#ifdef WINDOWSNT - uintptr_t thd = _beginthread (write_to_pipe, 0, stream); - int error = (thd == (uintptr_t)-1L) ? errno : 0; -#else /* !WINDOWSNT */ - pthread_t thread; - int error - = pthread_create (&thread, NULL, write_to_pipe, stream); -#endif - if (error != 0) - { - signal_system_error (env, error, "thread create"); - if (fclose (stream) != 0) - perror ("fclose"); - return NULL; - } - return env->intern (env, "nil"); -} - -static emacs_value -Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (nargs == 1); - return args[0]; -} - -/* 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 Qdefalias = env->intern (env, "defalias"); - emacs_value Qsym = env->intern (env, name); - emacs_value args[] = { Qsym, Sfun }; - - env->funcall (env, Qdefalias, 2, args); -} - -/* Module init function. */ -int -emacs_module_init (struct emacs_runtime *ert) -{ - /* Check that EMACS_MAJOR_VERSION is defined and an integral - constant. */ - char dummy[EMACS_MAJOR_VERSION]; - assert (27 <= sizeof dummy); - - if (ert->size < sizeof *ert) - { - fprintf (stderr, "Runtime size of runtime structure (%"pT" bytes) " - "smaller than compile-time size (%"pZ" bytes)", - (T_TYPE) ert->size, (Z_TYPE) sizeof (*ert)); - return 1; - } - - emacs_env *env = ert->get_environment (ert); - - if (env->size < sizeof *env) - { - fprintf (stderr, "Runtime size of environment structure (%"pT" bytes) " - "smaller than compile-time size (%"pZ" bytes)", - (T_TYPE) env->size, (Z_TYPE) sizeof (*env)); - return 2; - } - -#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\n\n(fn a b)", - (void *) (uintptr_t) 0x1234); - 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-globref-free", Fmod_test_globref_free, 4, 4, NULL, NULL); - DEFUN ("mod-test-globref-invalid-free", Fmod_test_globref_invalid_free, 0, 0, - NULL, NULL); - DEFUN ("mod-test-globref-reordered", Fmod_test_globref_reordered, 0, 0, NULL, - NULL); - DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); - DEFUN ("mod-test-return-unibyte", Fmod_test_return_unibyte, 0, 0, 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); - DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL); - DEFUN ("mod-test-invalid-store-copy", Fmod_test_invalid_store_copy, 0, 0, - NULL, NULL); - DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); - DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0, - NULL, NULL); - DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL); - DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); - DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); - DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); - DEFUN ("mod-test-make-function-with-finalizer", - Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); - DEFUN ("mod-test-function-finalizer-calls", - Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); - DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); - -#undef DEFUN - - emacs_value constant_fn - = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL); - env->make_interactive (env, constant_fn, env->intern (env, "nil")); - bind_function (env, "mod-test-return-t-int", constant_fn); - - emacs_value identity_fn - = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL); - const char *interactive_spec = "i"; - env->make_interactive (env, identity_fn, - env->make_string (env, interactive_spec, - strlen (interactive_spec))); - bind_function (env, "mod-test-identity", identity_fn); - - provide (env, "mod-test"); - return 0; -} diff --git a/test/data/files-bug18141.el.gz b/test/data/files-bug18141.el.gz deleted file mode 100644 index 53d463e85b5..00000000000 Binary files a/test/data/files-bug18141.el.gz and /dev/null differ diff --git a/test/data/mailcap/mime.types b/test/data/mailcap/mime.types deleted file mode 100644 index 4bedfaf9702..00000000000 --- a/test/data/mailcap/mime.types +++ /dev/null @@ -1,5 +0,0 @@ -# this is a comment - -audio/ogg opus -audio/flac flac -audio/x-wav wav diff --git a/test/data/somelib.el b/test/data/somelib.el deleted file mode 100644 index 7b8d4037396..00000000000 --- a/test/data/somelib.el +++ /dev/null @@ -1,7 +0,0 @@ -;;; -*- lexical-binding: t; -*- - -;; blah - -(defun somefunc () t) - -(provide 'somelib) diff --git a/test/data/somelib2.el b/test/data/somelib2.el deleted file mode 100644 index 05156145a22..00000000000 --- a/test/data/somelib2.el +++ /dev/null @@ -1,7 +0,0 @@ -;;; -*- lexical-binding: t; -*- - -;; blah - -(defun somefunc2 () t) - -(provide 'somelib2) diff --git a/test/data/syntax-comments.txt b/test/data/syntax-comments.txt deleted file mode 100644 index 6f595e4d8dc..00000000000 --- a/test/data/syntax-comments.txt +++ /dev/null @@ -1,68 +0,0 @@ -/* This file is a test file for tests of the comment handling in src/syntax.c. - This includes the testing of comments which figure in parse-partial-sexp - and scan-lists. */ - -/* Straight C comments */ -1/* comment */1 -2/**/2 -3// comment -3 -4// -4 -5/*/5 -6*/6 -7/* \*/7 -8*/8 -9/* \\*/9 -10*/10 -11// \ -12 -11 -13// \\ -14 -13 -15/* /*/15 - -/* C Comments within lists */ -59}59 -50{ /*70 comment */71 }50 -51{ /**/ }51 -52{ //72 comment -73}52 -53{ // -}53 -54{ //74 \ -}54 -55{/* */}55 -56{ /*76 \*/ }56 -57*/77 -58}58 -60{ /*78 \\*/79}60 - - -/* Straight Pascal comments (not nested) */ -20}20 -21{ Comment }21 -22{}22 -23{ -}23 -24{ -25{25 -}24 -26{ \}26 - - -/* Straight Lisp comments (not nested) */ -30 -30 -31; Comment -31 -32;;;;;;;;; -32 -33; \ -33 - -Local Variables: -mode: fundamental -eval: (set-syntax-table (make-syntax-table)) -End: diff --git a/test/data/xref/file1.txt b/test/data/xref/file1.txt deleted file mode 100644 index 5d7cc544443..00000000000 --- a/test/data/xref/file1.txt +++ /dev/null @@ -1,2 +0,0 @@ -foo foo -bar diff --git a/test/data/xref/file2.txt b/test/data/xref/file2.txt deleted file mode 100644 index 9f075f26004..00000000000 --- a/test/data/xref/file2.txt +++ /dev/null @@ -1,2 +0,0 @@ - -bar diff --git a/test/lisp/files-resources/files-bug18141.el.gz b/test/lisp/files-resources/files-bug18141.el.gz new file mode 100644 index 00000000000..53d463e85b5 Binary files /dev/null and b/test/lisp/files-resources/files-bug18141.el.gz differ diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 1b964af6887..8818099a223 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'nadvice) (eval-when-compile (require 'cl-lib)) (require 'bytecomp) ; `byte-compiler-base-file-name'. @@ -151,7 +152,7 @@ form.") (should (file-test--do-local-variables-test str subtest))))))) (defvar files-test-bug-18141-file - (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY")) + (ert-resource-file "files-bug18141.el.gz") "Test file for bug#18141.") (ert-deftest files-tests-bug-18141 () diff --git a/test/lisp/net/mailcap-resources/mime.types b/test/lisp/net/mailcap-resources/mime.types new file mode 100644 index 00000000000..4bedfaf9702 --- /dev/null +++ b/test/lisp/net/mailcap-resources/mime.types @@ -0,0 +1,5 @@ +# this is a comment + +audio/ogg opus +audio/flac flac +audio/x-wav wav diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index 8354d8e5e23..0ebbec61159 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -24,13 +24,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'mailcap) -(defconst mailcap-tests-data-dir - (expand-file-name "test/data/mailcap" source-directory)) - -(defconst mailcap-tests-path - (expand-file-name "mime.types" mailcap-tests-data-dir) +(defconst mailcap-tests-path (ert-resource-file "mime.types") "String used as PATH argument of `mailcap-parse-mimetypes'.") (defconst mailcap-tests-mime-extensions (copy-alist mailcap-mime-extensions)) diff --git a/test/lisp/progmodes/xref-resources/file1.txt b/test/lisp/progmodes/xref-resources/file1.txt new file mode 100644 index 00000000000..5d7cc544443 --- /dev/null +++ b/test/lisp/progmodes/xref-resources/file1.txt @@ -0,0 +1,2 @@ +foo foo +bar diff --git a/test/lisp/progmodes/xref-resources/file2.txt b/test/lisp/progmodes/xref-resources/file2.txt new file mode 100644 index 00000000000..9f075f26004 --- /dev/null +++ b/test/lisp/progmodes/xref-resources/file2.txt @@ -0,0 +1,2 @@ + +bar diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index a4980b2acb1..060c9cb5d1c 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -23,13 +23,12 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'xref) (require 'cl-lib) -(defvar xref-tests-data-dir - (expand-file-name "../../../data/xref/" - (or load-file-name - buffer-file-name))) +(defvar xref-tests-data-dir (ert-resource-directory)) (ert-deftest xref-matches-in-directory-finds-none-for-some-regexp () (should (null (xref-matches-in-directory "zzz" "*" xref-tests-data-dir nil)))) diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c new file mode 100644 index 00000000000..258a679b207 --- /dev/null +++ b/test/src/emacs-module-resources/mod-test.c @@ -0,0 +1,801 @@ +/* Test GNU Emacs modules. + +Copyright 2015-2020 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 "config.h" + +#undef NDEBUG +#include + +#include +#include +#include +#include +#include +#include +#include + +#ifdef WINDOWSNT +/* Cannot include because of the local header by the same + name, sigh. */ +uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); +# if !defined __x86_64__ +# define ALIGN_STACK __attribute__((force_align_arg_pointer)) +# endif +# include /* for Sleep */ +#else /* !WINDOWSNT */ +# include +# include +#endif + +#include +#include + +#include "timespec.h" + +int plugin_is_GPL_compatible; + +#if INTPTR_MAX <= 0 +# error "INTPTR_MAX misconfigured" +#elif INTPTR_MAX <= INT_MAX || INTPTR_MAX <= LONG_MAX +# define pT "ld" +# define pZ "lu" +# define T_TYPE long +# define Z_TYPE unsigned long +#elif INTPTR_MAX <= INT64_MAX +# ifdef __MINGW32__ +# define pT "lld" +# define pZ "llu" +# define T_TYPE long long +# define Z_TYPE unsigned long long +# else +# define pT "ld" +# define pZ "lu" +# define T_TYPE long +# define Z_TYPE unsigned long +# endif +#else +# error "INTPTR_MAX too large" +#endif + +/* Smoke test to verify that EMACS_LIMB_MAX is defined. */ +_Static_assert (0 < EMACS_LIMB_MAX, "EMACS_LIMB_MAX missing or incorrect"); + +/* 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); + assert ((uintptr_t) data == 0x1234); + + 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 NULL; +} + + +/* 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 NULL; +} + + +/* 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); +} + +/* Create a few global references from arguments and free them. */ +static emacs_value +Fmod_test_globref_free (emacs_env *env, ptrdiff_t nargs, emacs_value args[], + void *data) +{ + emacs_value refs[10]; + for (int i = 0; i < 10; i++) + { + refs[i] = env->make_global_ref (env, args[i % nargs]); + } + for (int i = 0; i < 10; i++) + { + env->free_global_ref (env, refs[i]); + } + return env->intern (env, "ok"); +} + +/* Treat a local reference as global and free it. Module assertions + should detect this case even if a global reference representing the + same object also exists. */ + +static emacs_value +Fmod_test_globref_invalid_free (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value local = env->make_integer (env, 9876); + env->make_global_ref (env, local); + env->free_global_ref (env, local); /* Not allowed. */ + return env->intern (env, "nil"); +} + +/* Allocate and free global references in a different order. */ + +static emacs_value +Fmod_test_globref_reordered (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value booleans[2] = { + env->intern (env, "nil"), + env->intern (env, "t"), + }; + emacs_value local = env->intern (env, "foo"); + emacs_value globals[4] = { + env->make_global_ref (env, local), + env->make_global_ref (env, local), + env->make_global_ref (env, env->intern (env, "foo")), + env->make_global_ref (env, env->intern (env, "bar")), + }; + emacs_value elements[4]; + for (int i = 0; i < 4; ++i) + elements[i] = booleans[env->eq (env, globals[i], local)]; + emacs_value ret = env->funcall (env, env->intern (env, "list"), 4, elements); + env->free_global_ref (env, globals[2]); + env->free_global_ref (env, globals[1]); + env->free_global_ref (env, globals[3]); + env->free_global_ref (env, globals[0]); + return ret; +} + + +/* 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'; + + emacs_value ret = env->make_string (env, buf, size - 1); + free (buf); + return ret; +} + + +/* Return a unibyte string. */ +static emacs_value +Fmod_test_return_unibyte (emacs_env *env, ptrdiff_t nargs, emacs_value args[], + void *data) +{ + const char *string = "foo\x00zot"; + return env->make_unibyte_string (env, string, 7); +} + + +/* 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"); +} + +static emacs_value invalid_stored_value; + +/* The next two functions perform a possibly-invalid operation: they + store a value in a static variable and load it. This causes + undefined behavior if the environment that the value was created + from is no longer live. The module assertions check for this + error. */ + +static emacs_value +Fmod_test_invalid_store (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + return invalid_stored_value = env->make_integer (env, 123); +} + +static emacs_value +Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + return invalid_stored_value; +} + +/* The next function works in conjunction with the two previous ones. + It stows away a copy of the object created by + `Fmod_test_invalid_store' in a global reference. Module assertions + should still detect the invalid load of the local reference. */ + +static emacs_value global_copy_of_invalid_stored_value; + +static emacs_value +Fmod_test_invalid_store_copy (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value local = Fmod_test_invalid_store (env, 0, NULL, NULL); + return global_copy_of_invalid_stored_value + = env->make_global_ref (env, local); +} + +/* An invalid finalizer: Finalizers are run during garbage collection, + where Lisp code can't be executed. -module-assertions tests for + this case. */ + +static emacs_env *current_env; + +static void +invalid_finalizer (void *ptr) +{ + current_env->intern (current_env, "nil"); +} + +static emacs_value +Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + current_env = env; + env->make_user_ptr (env, invalid_finalizer, NULL); + return env->intern (env, "nil"); +} + +static void +signal_system_error (emacs_env *env, int error, const char *function) +{ + const char *message = strerror (error); + emacs_value message_value = env->make_string (env, message, strlen (message)); + emacs_value symbol = env->intern (env, "file-error"); + emacs_value elements[2] + = {env->make_string (env, function, strlen (function)), message_value}; + emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); + env->non_local_exit_signal (env, symbol, data); +} + +static void +signal_errno (emacs_env *env, const char *function) +{ + signal_system_error (env, errno, function); +} + +/* A long-running operation that occasionally calls `should_quit' or + `process_input'. */ + +static emacs_value +Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 2); + const struct timespec until = env->extract_time (env, args[0]); + if (env->non_local_exit_check (env)) + return NULL; + const bool process_input = env->is_not_nil (env, args[1]); + const struct timespec amount = make_timespec(0, 10000000); + while (true) + { + const struct timespec now = current_timespec (); + if (timespec_cmp (now, until) >= 0) + break; + if (nanosleep (&amount, NULL) && errno != EINTR) + { + signal_errno (env, "nanosleep"); + return NULL; + } + if ((process_input + && env->process_input (env) == emacs_process_input_quit) + || env->should_quit (env)) + return NULL; + } + return env->intern (env, "finished"); +} + +static emacs_value +Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + struct timespec time = env->extract_time (env, args[0]); + assert (time.tv_nsec >= 0); + assert (time.tv_nsec < 2000000000); /* possible leap second */ + time.tv_nsec++; + return env->make_time (env, time); +} + +static void +signal_error (emacs_env *env, const char *message) +{ + emacs_value data = env->make_string (env, message, strlen (message)); + env->non_local_exit_signal (env, env->intern (env, "error"), + env->funcall (env, env->intern (env, "list"), 1, + &data)); +} + +static void +memory_full (emacs_env *env) +{ + signal_error (env, "Memory exhausted"); +} + +enum +{ + max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX) + / sizeof (emacs_limb_t)) +}; + +static bool +extract_big_integer (emacs_env *env, emacs_value arg, mpz_t result) +{ + int sign; + ptrdiff_t count; + bool success = env->extract_big_integer (env, arg, &sign, &count, NULL); + if (!success) + return false; + if (sign == 0) + { + mpz_set_ui (result, 0); + return true; + } + enum { order = -1, size = sizeof (emacs_limb_t), endian = 0, nails = 0 }; + assert (0 < count && count <= max_count); + emacs_limb_t *magnitude = malloc (count * size); + if (magnitude == NULL) + { + memory_full (env); + return false; + } + success = env->extract_big_integer (env, arg, NULL, &count, magnitude); + assert (success); + mpz_import (result, count, order, size, endian, nails, magnitude); + free (magnitude); + if (sign < 0) + mpz_neg (result, result); + return true; +} + +static emacs_value +make_big_integer (emacs_env *env, const mpz_t value) +{ + if (mpz_sgn (value) == 0) + return env->make_integer (env, 0); + /* See + https://gmplib.org/manual/Integer-Import-and-Export.html#index-Export. */ + enum + { + order = -1, + size = sizeof (emacs_limb_t), + endian = 0, + nails = 0, + numb = 8 * size - nails + }; + size_t count = (mpz_sizeinbase (value, 2) + numb - 1) / numb; + if (max_count < count) + { + memory_full (env); + return NULL; + } + emacs_limb_t *magnitude = malloc (count * size); + if (magnitude == NULL) + { + memory_full (env); + return NULL; + } + size_t written; + mpz_export (magnitude, &written, order, size, endian, nails, value); + assert (written == count); + assert (count <= PTRDIFF_MAX); + emacs_value result = env->make_big_integer (env, mpz_sgn (value), + (ptrdiff_t) count, magnitude); + free (magnitude); + return result; +} + +static emacs_value +Fmod_test_nanoseconds (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) { + assert (nargs == 1); + struct timespec time = env->extract_time (env, args[0]); + mpz_t nanoseconds; + assert (LONG_MIN <= time.tv_sec && time.tv_sec <= LONG_MAX); + mpz_init_set_si (nanoseconds, time.tv_sec); +#ifdef __MINGW32__ + _Static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); +#else + static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); +#endif + mpz_mul_ui (nanoseconds, nanoseconds, 1000000000); + assert (0 <= time.tv_nsec && time.tv_nsec <= ULONG_MAX); + mpz_add_ui (nanoseconds, nanoseconds, time.tv_nsec); + emacs_value result = make_big_integer (env, nanoseconds); + mpz_clear (nanoseconds); + return result; +} + +static emacs_value +Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + emacs_value arg = args[0]; + mpz_t value; + mpz_init (value); + extract_big_integer (env, arg, value); + mpz_mul_ui (value, value, 2); + emacs_value result = make_big_integer (env, value); + mpz_clear (value); + return result; +} + +static int function_data; +static int finalizer_calls_with_correct_data; +static int finalizer_calls_with_incorrect_data; + +static void +finalizer (void *data) +{ + if (data == &function_data) + ++finalizer_calls_with_correct_data; + else + ++finalizer_calls_with_incorrect_data; +} + +static emacs_value +Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value fun + = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data); + env->set_function_finalizer (env, fun, finalizer); + if (env->get_function_finalizer (env, fun) != finalizer) + signal_error (env, "Invalid finalizer"); + return fun; +} + +static emacs_value +Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value Flist = env->intern (env, "list"); + emacs_value list_args[] + = {env->make_integer (env, finalizer_calls_with_correct_data), + env->make_integer (env, finalizer_calls_with_incorrect_data)}; + return env->funcall (env, Flist, 2, list_args); +} + +static void +sleep_for_half_second (void) +{ + /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */ +#ifdef WINDOWSNT + Sleep (500); +#else + const struct timespec sleep = {0, 500000000}; + if (nanosleep (&sleep, NULL) != 0) + perror ("nanosleep"); +#endif +} + +#ifdef WINDOWSNT +static void ALIGN_STACK +#else +static void * +#endif +write_to_pipe (void *arg) +{ + /* We sleep a bit to test that writing to a pipe is indeed possible + if no environment is active. */ + sleep_for_half_second (); + FILE *stream = arg; + /* The string below should be identical to the one we compare with + in emacs-module-tests.el:module/async-pipe. */ + if (fputs ("data from thread", stream) < 0) + perror ("fputs"); + if (fclose (stream) != 0) + perror ("close"); +#ifndef WINDOWSNT + return NULL; +#endif +} + +static emacs_value +Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + int fd = env->open_channel (env, args[0]); + if (env->non_local_exit_check (env) != emacs_funcall_exit_return) + return NULL; + FILE *stream = fdopen (fd, "w"); + if (stream == NULL) + { + signal_errno (env, "fdopen"); + return NULL; + } +#ifdef WINDOWSNT + uintptr_t thd = _beginthread (write_to_pipe, 0, stream); + int error = (thd == (uintptr_t)-1L) ? errno : 0; +#else /* !WINDOWSNT */ + pthread_t thread; + int error + = pthread_create (&thread, NULL, write_to_pipe, stream); +#endif + if (error != 0) + { + signal_system_error (env, error, "thread create"); + if (fclose (stream) != 0) + perror ("fclose"); + return NULL; + } + return env->intern (env, "nil"); +} + +static emacs_value +Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + return args[0]; +} + +/* 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 Qdefalias = env->intern (env, "defalias"); + emacs_value Qsym = env->intern (env, name); + emacs_value args[] = { Qsym, Sfun }; + + env->funcall (env, Qdefalias, 2, args); +} + +/* Module init function. */ +int +emacs_module_init (struct emacs_runtime *ert) +{ + /* Check that EMACS_MAJOR_VERSION is defined and an integral + constant. */ + char dummy[EMACS_MAJOR_VERSION]; + assert (27 <= sizeof dummy); + + if (ert->size < sizeof *ert) + { + fprintf (stderr, "Runtime size of runtime structure (%"pT" bytes) " + "smaller than compile-time size (%"pZ" bytes)", + (T_TYPE) ert->size, (Z_TYPE) sizeof (*ert)); + return 1; + } + + emacs_env *env = ert->get_environment (ert); + + if (env->size < sizeof *env) + { + fprintf (stderr, "Runtime size of environment structure (%"pT" bytes) " + "smaller than compile-time size (%"pZ" bytes)", + (T_TYPE) env->size, (Z_TYPE) sizeof (*env)); + return 2; + } + +#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\n\n(fn a b)", + (void *) (uintptr_t) 0x1234); + 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-globref-free", Fmod_test_globref_free, 4, 4, NULL, NULL); + DEFUN ("mod-test-globref-invalid-free", Fmod_test_globref_invalid_free, 0, 0, + NULL, NULL); + DEFUN ("mod-test-globref-reordered", Fmod_test_globref_reordered, 0, 0, NULL, + NULL); + DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); + DEFUN ("mod-test-return-unibyte", Fmod_test_return_unibyte, 0, 0, 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); + DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL); + DEFUN ("mod-test-invalid-store-copy", Fmod_test_invalid_store_copy, 0, 0, + NULL, NULL); + DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); + DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0, + NULL, NULL); + DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL); + DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); + DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); + DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); + DEFUN ("mod-test-make-function-with-finalizer", + Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); + DEFUN ("mod-test-function-finalizer-calls", + Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); + DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); + +#undef DEFUN + + emacs_value constant_fn + = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL); + env->make_interactive (env, constant_fn, env->intern (env, "nil")); + bind_function (env, "mod-test-return-t-int", constant_fn); + + emacs_value identity_fn + = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL); + const char *interactive_spec = "i"; + env->make_interactive (env, identity_fn, + env->make_string (env, interactive_spec, + strlen (interactive_spec))); + bind_function (env, "mod-test-identity", identity_fn); + + provide (env, "mod-test"); + return 0; +} diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 621229c62aa..fb4ed4a6842 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -21,13 +21,14 @@ ;; Unit tests for the dynamic module facility. See Info node `(elisp) ;; Writing Dynamic Modules'. These tests make use of a small test -;; module in test/data/emacs-module. +;; module in the "emacs-module-resources" directory. ;;; Code: ;;; Prelude (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'help-fns) (defconst mod-test-emacs @@ -35,8 +36,7 @@ "File name of the Emacs binary currently running.") (eval-and-compile - (defconst mod-test-file - (expand-file-name "../test/data/emacs-module/mod-test" invocation-directory) + (defconst mod-test-file (ert-resource-file "mod-test") "File name of the module test file.")) (require 'mod-test mod-test-file) @@ -313,11 +313,11 @@ local reference." (text-quoting-style 'grave)) (describe-function-1 #'mod-test-sum) (goto-char (point-min)) - (while (re-search-forward "`[^']*/data/emacs-module/" nil t) - (replace-match "`data/emacs-module/")) + (while (re-search-forward "`[^']*/src/emacs-module-resources/" nil t) + (replace-match "`src/emacs-module-resources/")) (should (equal (buffer-substring-no-properties 1 (point-max)) - (format "a module function in `data/emacs-module/mod-test%s'. + (format "a module function in `src/emacs-module-resources/mod-test%s'. (mod-test-sum a b) diff --git a/test/src/lread-resources/somelib.el b/test/src/lread-resources/somelib.el new file mode 100644 index 00000000000..7b8d4037396 --- /dev/null +++ b/test/src/lread-resources/somelib.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t; -*- + +;; blah + +(defun somefunc () t) + +(provide 'somelib) diff --git a/test/src/lread-resources/somelib2.el b/test/src/lread-resources/somelib2.el new file mode 100644 index 00000000000..05156145a22 --- /dev/null +++ b/test/src/lread-resources/somelib2.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t; -*- + +;; blah + +(defun somefunc2 () t) + +(provide 'somelib2) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 26fd6aa22a1..825b74e6234 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -25,6 +25,9 @@ ;;; Code: +(require 'ert) +(require 'ert-x) + (ert-deftest lread-char-number () (should (equal (read "?\\N{U+A817}") #xA817))) @@ -146,10 +149,7 @@ literals (Bug#20852)." (ert-deftest lread-test-bug26837 () "Test for https://debbugs.gnu.org/26837 ." - (let ((load-path (cons - (file-name-as-directory - (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) - load-path))) + (let ((load-path (cons (ert-resource-directory) load-path))) (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))) (load "somelib2" nil t) diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt new file mode 100644 index 00000000000..6f595e4d8dc --- /dev/null +++ b/test/src/syntax-resources/syntax-comments.txt @@ -0,0 +1,68 @@ +/* This file is a test file for tests of the comment handling in src/syntax.c. + This includes the testing of comments which figure in parse-partial-sexp + and scan-lists. */ + +/* Straight C comments */ +1/* comment */1 +2/**/2 +3// comment +3 +4// +4 +5/*/5 +6*/6 +7/* \*/7 +8*/8 +9/* \\*/9 +10*/10 +11// \ +12 +11 +13// \\ +14 +13 +15/* /*/15 + +/* C Comments within lists */ +59}59 +50{ /*70 comment */71 }50 +51{ /**/ }51 +52{ //72 comment +73}52 +53{ // +}53 +54{ //74 \ +}54 +55{/* */}55 +56{ /*76 \*/ }56 +57*/77 +58}58 +60{ /*78 \\*/79}60 + + +/* Straight Pascal comments (not nested) */ +20}20 +21{ Comment }21 +22{}22 +23{ +}23 +24{ +25{25 +}24 +26{ \}26 + + +/* Straight Lisp comments (not nested) */ +30 +30 +31; Comment +31 +32;;;;;;;;; +32 +33; \ +33 + +Local Variables: +mode: fundamental +eval: (set-syntax-table (make-syntax-table)) +End: diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index 56e03380579..4b9c3f277aa 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (ert-deftest parse-partial-sexp-continue-over-comment-marker () "Continue a parse that stopped in the middle of a comment marker." @@ -91,7 +92,7 @@ also has open paren syntax (see Bug#24870)." ;; It is intended to enhance this bit to test nested comments ;; (2020-10-01). -;; This bit uses the data file test/data/syntax-comments.txt. +;; This bit uses the data file syntax-resources/syntax-comments.txt. (defun syntax-comments-point (n forw) "Return the buffer offset corresponding to the \"label\" N. @@ -182,8 +183,7 @@ missing or nil, the value of START is assumed for it." () (with-current-buffer (find-file - ,(expand-file-name "data/syntax-comments.txt" - (getenv "EMACS_TEST_DIRECTORY"))) + ,(ert-resource-file "syntax-comments.txt")) (,(intern (concat (symbol-name type) "-in"))) (goto-char (syntax-comments-point ,start ,forw)) (let ((stop (syntax-comments-point ,(or stop start) ,(not forw)))) @@ -230,8 +230,7 @@ missing or nil, the value of -START- is assumed for it." () (with-current-buffer (find-file - ,(expand-file-name "data/syntax-comments.txt" - (getenv "EMACS_TEST_DIRECTORY"))) + ,(ert-resource-file "syntax-comments.txt")) (,(intern (concat (symbol-name type) "-in"))) (let ((start-pos (syntax-comments-point ,start ,forw)) ,@(if res @@ -285,8 +284,7 @@ the `parse-partial-sexp's are expected to stop. See () (with-current-buffer (find-file - ,(expand-file-name "data/syntax-comments.txt" - (getenv "EMACS_TEST_DIRECTORY"))) + ,(ert-resource-file "syntax-comments.txt")) (,(intern (concat (symbol-name type) "-in"))) (let ((start-pos (syntax-comments-point ,start t)) (open-pos (syntax-comments-midpoint ,open))