diff --git a/modules/.gitignore b/modules/.gitignore new file mode 100644 index 00000000000..33a872ef84a --- /dev/null +++ b/modules/.gitignore @@ -0,0 +1,8 @@ +# built modules +*.so + +# built DOCFILEs +*.doc + +# include makefile for now +!Makefile diff --git a/modules/mod-test/Makefile b/modules/mod-test/Makefile new file mode 100644 index 00000000000..18778f00599 --- /dev/null +++ b/modules/mod-test/Makefile @@ -0,0 +1,15 @@ + +ROOT = ../.. + +CC = gcc +LD = gcc +CFLAGS = -ggdb3 -Wall +LDFLAGS = + +all: mod-test.so + +%.so: %.o + $(LD) -shared $(LDFLAGS) -o $@ $< + +%.o: %.c + $(CC) $(CFLAGS) -I$(ROOT)/src -fPIC -c $< diff --git a/modules/mod-test/mod-test.c b/modules/mod-test/mod-test.c new file mode 100644 index 00000000000..2de53152b1b --- /dev/null +++ b/modules/mod-test/mod-test.c @@ -0,0 +1,254 @@ +#include +#include +#include + +int plugin_is_GPL_compatible; + +/* + * Always return symbol 't' + */ +static emacs_value Fmod_test_return_t (emacs_env *env, int nargs, emacs_value args[], void *data) +{ + return env->intern (env, "t"); +} + + +/* + * Expose simple sum function + */ +static int64_t sum (int64_t a, int64_t b) +{ + return a + b; +} + +static emacs_value Fmod_test_sum (emacs_env *env, int nargs, emacs_value args[], void* data) +{ + int64_t a = env->extract_integer (env, args[0]); + int64_t b = env->extract_integer (env, args[1]); + + int64_t r = sum(a, b); + + return env->make_integer (env, r); +} + + +/* + * Signal '(error 56) + */ +static emacs_value Fmod_test_signal (emacs_env *env, int 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, int 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, int nargs, emacs_value args[], void* data) +{ + assert (nargs == 1); + const 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); + const 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); + const 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 referrence + */ +static emacs_value Fmod_test_globref_make (emacs_env *env, int nargs, emacs_value args[], void* data) +{ + /* make a big string and make it global */ + size_t i; + char str[26*100]; + + for (i = 0; i < sizeof (str); i++) + { + str[i] = 'a' + (i % 26); + } + + /* we don't need to null-terminate str */ + emacs_value lisp_str = env->make_string (env, str, sizeof (str)); + return env->make_global_ref (env, lisp_str); +} + + +/* + * Return a copy of the argument string where every 'a' is replaced with 'b'. + */ +static emacs_value Fmod_test_string_a_to_b (emacs_env *env, int nargs, emacs_value args[], void* data) +{ + emacs_value lisp_str = args[0]; + size_t size = 0; + char * buf = NULL; + size_t i; + + env->copy_string_contents (env, lisp_str, buf, &size); + buf = malloc (size); + env->copy_string_contents (env, lisp_str, buf, &size); + + for (i = 0; i+1 < size; i++) { + if (buf[i] == 'a') + buf[i] = 'b'; + } + + return env->make_string (env, buf, size-1); +} + + +/* + * Embedded pointers in lisp objects. + */ + +/* C struct (pointer to) that will be embedded */ +struct super_struct +{ + int amazing_int; + char large_unused_buffer[512]; +}; + +/* Associated finalizer */ +static void finalizer (void *p) +{ + if (p) + free (p); +} + +/* + * 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, int 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, finalizer, p); +} + +/* + * Return the amazing_int of a passed 'user-pointer to a super_struct'. + */ +static emacs_value Fmod_test_userptr_get (emacs_env *env, int 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, int nargs, emacs_value args[], void *data) +{ + size_t i; + emacs_value vec = args[0]; + emacs_value val = args[1]; + const size_t size = env->vec_size (env, vec); + for (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, int nargs, emacs_value args[], void *data) +{ + size_t i; + emacs_value vec = args[0]; + emacs_value val = args[1]; + const size_t size = env->vec_size (env, vec); + for (i = 0; i < size; i++) + if (!env->eq (env, env->vec_get (env, vec, i), val)) + return env->intern (env, "nil"); + return env->intern (env, "t"); +} + + +/* + * Lisp utilities for easier readability (simple wrappers) + */ + +/* Provide FEATURE to Emacs */ +static void provide (emacs_env *env, const char *feature) +{ + emacs_value Qfeat = env->intern (env, feature); + emacs_value Qprovide = env->intern (env, "provide"); + emacs_value args[] = { Qfeat }; + + env->funcall (env, Qprovide, 1, args); +} + +/* Binds NAME to FUN */ +static void bind_function (emacs_env *env, const char *name, emacs_value Sfun) +{ + emacs_value Qfset = env->intern (env, "fset"); + emacs_value Qsym = env->intern (env, name); + emacs_value args[] = { Qsym, Sfun }; + + env->funcall (env, Qfset, 2, args); +} + +/* + * Module init function. + */ +int emacs_module_init (struct emacs_runtime *ert) +{ + emacs_env *env = ert->get_environment (ert); + +#define DEFUN(lsym, csym, amin, amax, doc, data) \ + bind_function (env, lsym, env->make_function (env, amin, amax, csym, doc, data)) + + DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL); + DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL); + DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL); + DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL); + DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall, 1, 1, NULL, NULL); + DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL); + DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); + DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL); + DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL); + DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL); + DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL); + +#undef DEFUN + + provide (env, "mod-test"); + return 0; +} diff --git a/modules/mod-test/test.el b/modules/mod-test/test.el new file mode 100644 index 00000000000..1242b6a2ec2 --- /dev/null +++ b/modules/mod-test/test.el @@ -0,0 +1,91 @@ +;; +;; Dynamic modules tests +;; + +(require 'ert) + +(add-to-list 'load-path (file-name-directory (or #$ (expand-file-name (buffer-file-name))))) +(require 'mod-test) + +;; +;; basic tests +;; + +(ert-deftest mod-test-sum-test () + (should (= (mod-test-sum 1 2) 3))) + +(ert-deftest mod-test-sum-docstring () + (should (string= (documentation 'mod-test-sum) "Return A + B"))) + +;; +;; non-local exists (throw, signal) +;; + +(ert-deftest mod-test-non-local-exit-signal-test () + (should-error (mod-test-signal))) + +(ert-deftest mod-test-non-local-exit-throw-test () + (should (equal + (catch 'tag + (mod-test-throw) + (ert-fail "expected throw")) + 65))) + +(ert-deftest mod-test-non-local-exit-funcall-normal () + (should (equal (mod-test-non-local-exit-funcall (lambda () 23)) + 23))) + +(ert-deftest mod-test-non-local-exit-funcall-signal () + (should (equal (mod-test-non-local-exit-funcall (lambda () (signal 'error '(32)))) + '(signal error (32))))) + +(ert-deftest mod-test-non-local-exit-funcall-throw () + (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32))) + '(throw tag 32)))) + +;; +;; string +;; + +(defun multiply-string (s n) + (let ((res "")) + (dotimes (i n res) + (setq res (concat res s))))) + +(ert-deftest mod-test-globref-make-test () + (let ((mod-str (mod-test-globref-make)) + (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100))) + (garbage-collect) ;; XXX: not enough to really test but it's something.. + (should (string= ref-str mod-str)))) + +(ert-deftest mod-test-string-a-to-b-test () + (should (string= (mod-test-string-a-to-b "aaa") "bbb"))) + +;; +;; user-pointer +;; + +(ert-deftest mod-test-userptr-fun-test () + (let* ((n 42) + (v (mod-test-userptr-make n)) + (r (mod-test-userptr-get v))) + + (should (eq (type-of v) 'user-ptr)) + (should (integerp r)) + (should (= r n)))) + +;; TODO: try to test finalizer + +;; +;; vectors +;; + +(ert-deftest mod-test-vector-test () + (dolist (s '(2 10 100 1000)) + (dolist (e '(42 foo "foo")) + (let* ((v-ref (make-vector 2 e)) + (eq-ref (eq (aref v-ref 0) (aref v-ref 1))) + (v-test (make-vector s nil))) + + (should (eq (mod-test-vector-fill v-test e) t)) + (should (eq (mod-test-vector-eq v-test e) eq-ref)))))) diff --git a/modules/modhelp.py b/modules/modhelp.py new file mode 100755 index 00000000000..ef41ba5a917 --- /dev/null +++ b/modules/modhelp.py @@ -0,0 +1,178 @@ +#!/usr/bin/env python +import os +import string +import subprocess as sp +import argparse +import re + +EMACS = os.path.join('..', 'src', 'emacs') + +def find_modules(): + modpaths = [] + for (dirname, dirs, files) in os.walk('.'): + if 'Makefile' in files: + modpaths.append(dirname) + return modpaths + +def cmd_test(args): + mods = args.module + if not mods: + mods = find_modules() + + make_cmd = ['make'] + if args.force: + make_cmd.append('-B') + + failed = [] + for m in mods: + print '[*] %s: ------- start -------' % m + print '[*] %s: running make' % m + r = sp.call(make_cmd, cwd=m) + if r != 0: + print '[E] %s: make failed' % m + failed += [m] + continue + + print '[*] %s: running test' % m + testpath = os.path.join(m, 'test.el') + if os.path.isfile(testpath): + emacs_cmd = [EMACS, '-batch', '-L', '.', '-l', 'ert', '-l', testpath, '-f', 'ert-run-tests-batch-and-exit'] + print ' '.join(emacs_cmd) + r = sp.call(emacs_cmd) + if r != 0: + print '[E] %s: test failed' % m + failed += [m] + continue + else: + print '[W] %s: no test to run' % m + + print '\n[*] %d/%d MODULES OK' % (len(mods)-len(failed), len(mods)) + for m in failed: + print '\tfailed: %s' % m + +def to_lisp_sym(sym): + sym = re.sub('[_ ]', '-', sym) + return sym + +def to_c_sym(sym): + sym = re.sub('[- ]', '_', sym) + return sym + +def cmd_init(args): + if os.path.exists(args.module): + print "%s: file/dir '%s' already exists" % (__file__, args.module) + return + + os.mkdir(args.module) + + template_vars = { + 'module': args.module, + 'func': args.fun, + 'c_file': '%s.c' % args.module, + 'c_func': 'F%s_%s' % (to_c_sym(args.module), to_c_sym(args.fun)), + 'lisp_func': '%s-%s' % (args.module, to_lisp_sym(args.fun)), + } + + for path, t in TEMPLATES.items(): + if isinstance(path, string.Template): + path = path.substitute(template_vars) + path = os.path.join(args.module, path) + print "writing %s..." % path + with open(path, "w+") as f: + f.write(t.substitute(template_vars)) + print "done! you can run %s test %s" % (__file__, args.module) + + +def main(): + # path always written relative to this file + os.chdir(os.path.dirname(os.path.realpath(__file__))) + + mainp = argparse.ArgumentParser() + subp = mainp.add_subparsers() + + testp = subp.add_parser('test', help='run tests') + testp.add_argument('-f', '--force', action='store_true', help='force regeneration (make -B)') + testp.add_argument('module', nargs='*', help='path to module to test (default all)') + testp.set_defaults(func=cmd_test) + + initp = subp.add_parser('init', help='create a test module from a template') + initp.add_argument('module', help='name of the new module') + initp.add_argument('-f', '--fun', default='fun', help='overide name of the default function') + initp.set_defaults(func=cmd_init) + + args = mainp.parse_args() + args.func(args) + + +# double the $ to escape python template syntax +TEMPLATES = { + 'Makefile': string.Template(''' +ROOT = ../.. + +CC = gcc +LD = gcc +CFLAGS = -ggdb3 -Wall +LDFLAGS = + +all: ${module}.so ${module}.doc + +%.so: %.o + $$(LD) -shared $$(LDFLAGS) -o $$@ $$< + +%.o: %.c + $$(CC) $$(CFLAGS) -I$$(ROOT)/src -fPIC -c $$< + +'''), + + string.Template('${c_file}'): string.Template(''' +#include + +int plugin_is_GPL_compatible; + +static emacs_value ${c_func} (emacs_env *env, int nargs, emacs_value args[], void *data) +{ + return env->intern (env, "t"); +} + +/* Binds NAME to FUN */ +static void bind_function (emacs_env *env, const char *name, emacs_value Sfun) +{ + emacs_value Qfset = env->intern (env, "fset"); + emacs_value Qsym = env->intern (env, name); + emacs_value args[] = { Qsym, Sfun }; + + env->funcall (env, Qfset, 2, args); +} + +/* 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); +} + +int emacs_module_init (struct emacs_runtime *ert) +{ + emacs_env *env = ert->get_environment (ert); + bind_function (env, "${lisp_func}", env->make_function (env, 1, 1, ${c_func}, "doc", NULL)); + provide (env, "${module}"); + return 0; +} +'''), + 'test.el': string.Template(''' +(require 'ert) +(require 'module-test-common) + +;; #$$ works when loading, buffer-file-name when evaluating from emacs +(module-load (module-path (or #$$ (expand-file-name (buffer-file-name))))) + +(ert-deftest ${lisp_func}-test () + (should (eq (${lisp_func} 42) t))) +''') +} + +if __name__ == '__main__': + main()