[Emacs-diffs] emacs-25 955e25d 6/6: Add dynamic module test and helper script

[Teodor Zlatanov]

branch: emacs-25
commit 955e25dbcd0519d115f58b275923a71c04579e83
Author: Aurélien Aptel <address@hidden>
Commit: Ted Zlatanov <address@hidden>

    Add dynamic module test and helper script
    
    Add 'modhelp.py' script (python2) to automate module testing and
    module generation.
    
    To build and test all modules in the modules/ dir
      $ ./modhelp.py test
    
    To generate a module from template code (good starting point)
      $ ./modhelp init mynewtestmodule
    
    See the script -h option for more documentation.
    
    * modules/modhelp.py: New module helper script.
    * modules/mod-test/Makefile: New file. Makefile for the test module.
    * modules/mod-test/mod-test.c: New file. Test module source file.
    * modules/mod-test/test.el: New file. ert test suite for the test module.
    * modules/.gitignore: New file. Local .gitignore file.
    
    Co-authored-by: Philipp Stephani <address@hidden>
---
 modules/.gitignore          |    8 ++
 modules/mod-test/Makefile   |   15 +++
 modules/mod-test/mod-test.c |  254 +++++++++++++++++++++++++++++++++++++++++++
 modules/mod-test/test.el    |   91 +++++++++++++++
 modules/modhelp.py          |  178 ++++++++++++++++++++++++++++++
 5 files changed, 546 insertions(+), 0 deletions(-)

diff --git a/modules/.gitignore b/modules/.gitignore
new file mode 100644
index 0000000..33a872e
--- /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 0000000..18778f0
--- /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 0000000..2de5315
--- /dev/null
+++ b/modules/mod-test/mod-test.c
@@ -0,0 +1,254 @@
+#include <assert.h>
+#include <stdio.h>
+#include <emacs_module.h>
+
+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 0000000..1242b6a
--- /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 0000000..ef41ba5
--- /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 <emacs_module.h>
+
+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()