test/src/emacs-module-tests.el

   1 ;;; Test GNU Emacs modules.
   2
   3 ;; Copyright 2015-2017 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 (require 'ert)
  21
  22 (defconst mod-test-emacs
  23   (expand-file-name invocation-name invocation-directory)
  24   "File name of the Emacs binary currently running.")
  25
  26 (eval-and-compile
  27   (defconst mod-test-file
  28     (substitute-in-file-name
  29      "$EMACS_TEST_DIRECTORY/data/emacs-module/mod-test")
  30     "File name of the module test file."))
  31
  32 (require 'mod-test mod-test-file)
  33
  34 ;;
  35 ;; Basic tests.
  36 ;;
  37
  38 (ert-deftest mod-test-sum-test ()
  39   (should (= (mod-test-sum 1 2) 3))
  40   (let ((descr (should-error (mod-test-sum 1 2 3))))
  41     (should (eq (car descr) 'wrong-number-of-arguments))
  42     (should (module-function-p (nth 1 descr)))
  43     (should (eq 0
  44                 (string-match
  45                  (concat "#<module function "
  46                          "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
  47                          "\\|Fmod_test_sum from .*\\)>")
  48                  (prin1-to-string (nth 1 descr)))))
  49     (should (= (nth 2 descr) 3)))
  50   (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
  51   (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
  52   ;; The following tests are for 32-bit build --with-wide-int.
  53   (should (= (mod-test-sum -1 most-positive-fixnum)
  54              (1- most-positive-fixnum)))
  55   (should (= (mod-test-sum 1 most-negative-fixnum)
  56              (1+ most-negative-fixnum)))
  57   (when (< #x1fffffff most-positive-fixnum)
  58     (should (= (mod-test-sum 1 #x1fffffff)
  59                (1+ #x1fffffff)))
  60     (should (= (mod-test-sum -1 #x20000000)
  61                #x1fffffff)))
  62   (should-error (mod-test-sum 1 most-positive-fixnum)
  63                 :type 'overflow-error)
  64   (should-error (mod-test-sum -1 most-negative-fixnum)
  65                 :type 'overflow-error))
  66
  67 (ert-deftest mod-test-sum-docstring ()
  68   (should (string= (documentation 'mod-test-sum) "Return A + B\n\n(fn a b)")))
  69
  70 (ert-deftest module-function-object ()
  71   "Extract and test the implementation of a module function.
  72 This test needs to be changed whenever the implementation
  73 changes."
  74   (let ((func (symbol-function #'mod-test-sum)))
  75     (should (module-function-p func))
  76     (should (equal (type-of func) 'module-function))
  77     (should (string-match-p
  78              (rx bos "#<module function "
  79                  (or "Fmod_test_sum"
  80                      (and "at 0x" (+ hex-digit)))
  81                  (? " from " (* nonl) "mod-test" (* nonl) )
  82                  ">" eos)
  83              (prin1-to-string func)))))
  84
  85 ;;
  86 ;; Non-local exists (throw, signal).
  87 ;;
  88
  89 (ert-deftest mod-test-non-local-exit-signal-test ()
  90   (should-error (mod-test-signal))
  91   (let (debugger-args backtrace)
  92     (should-error
  93      (let ((debugger (lambda (&rest args)
  94                        (setq debugger-args args
  95                              backtrace (with-output-to-string (backtrace)))
  96                        (cl-incf num-nonmacro-input-events)))
  97            (debug-on-signal t))
  98        (mod-test-signal)))
  99     (should (equal debugger-args '(error (error . 56))))
 100     (should (string-match-p
 101              (rx bol "  mod-test-signal()" eol)
 102              backtrace))))
 103
 104 (ert-deftest mod-test-non-local-exit-throw-test ()
 105   (should (equal
 106            (catch 'tag
 107              (mod-test-throw)
 108              (ert-fail "expected throw"))
 109            65)))
 110
 111 (ert-deftest mod-test-non-local-exit-funcall-normal ()
 112   (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
 113                  23)))
 114
 115 (ert-deftest mod-test-non-local-exit-funcall-signal ()
 116   (should (equal (mod-test-non-local-exit-funcall
 117                   (lambda () (signal 'error '(32))))
 118                  '(signal error (32)))))
 119
 120 (ert-deftest mod-test-non-local-exit-funcall-throw ()
 121   (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
 122                  '(throw tag 32))))
 123
 124 ;;
 125 ;; String tests.
 126 ;;
 127
 128 (defun multiply-string (s n)
 129   (let ((res ""))
 130     (dotimes (i n res)
 131       (setq res (concat res s)))))
 132
 133 (ert-deftest mod-test-globref-make-test ()
 134   (let ((mod-str (mod-test-globref-make))
 135         (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
 136     (garbage-collect) ;; XXX: not enough to really test but it's something..
 137     (should (string= ref-str mod-str))))
 138
 139 (ert-deftest mod-test-string-a-to-b-test ()
 140   (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
 141
 142 ;;
 143 ;; User-pointer tests.
 144 ;;
 145
 146 (ert-deftest mod-test-userptr-fun-test ()
 147   (let* ((n 42)
 148          (v (mod-test-userptr-make n))
 149          (r (mod-test-userptr-get v)))
 150
 151     (should (eq (type-of v) 'user-ptr))
 152     (should (integerp r))
 153     (should (= r n))))
 154
 155 ;; TODO: try to test finalizer
 156
 157 ;;
 158 ;; Vector tests.
 159 ;;
 160
 161 (ert-deftest mod-test-vector-test ()
 162   (dolist (s '(2 10 100 1000))
 163     (dolist (e '(42 foo "foo"))
 164       (let* ((v-ref (make-vector 2 e))
 165              (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
 166              (v-test (make-vector s nil)))
 167
 168         (should (eq (mod-test-vector-fill v-test e) t))
 169         (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
 170
 171 (ert-deftest module--func-arity ()
 172   (should (equal (func-arity #'mod-test-return-t) '(1 . 1)))
 173   (should (equal (func-arity #'mod-test-sum) '(2 . 2))))
 174
 175 (ert-deftest module--help-function-arglist ()
 176   (should (equal (help-function-arglist #'mod-test-return-t :preserve-names)
 177                  '(arg1)))
 178   (should (equal (help-function-arglist #'mod-test-return-t)
 179                  '(arg1)))
 180   (should (equal (help-function-arglist #'mod-test-sum :preserve-names)
 181                  '(a b)))
 182   (should (equal (help-function-arglist #'mod-test-sum)
 183                  '(arg1 arg2))))
 184
 185 (defmacro module--with-temp-directory (name &rest body)
 186   "Bind NAME to the name of a temporary directory and evaluate BODY.
 187 NAME must be a symbol.  Delete the temporary directory after BODY
 188 exits normally or non-locally.  NAME will be bound to the
 189 directory name (not the directory file name) of the temporary
 190 directory."
 191   (declare (indent 1))
 192   (cl-check-type name symbol)
 193   `(let ((,name (file-name-as-directory
 194                  (make-temp-file "emacs-module-test" :directory))))
 195      (unwind-protect
 196          (progn ,@body)
 197        (delete-directory ,name :recursive))))
 198
 199 (defmacro module--test-assertion (pattern &rest body)
 200   "Test that PATTERN matches the assertion triggered by BODY.
 201 Run Emacs as a subprocess, load the test module `mod-test-file',
 202 and evaluate BODY.  Verify that Emacs aborts and prints a module
 203 assertion message that matches PATTERN.  PATTERN is evaluated and
 204 must evaluate to a regular expression string."
 205   (declare (indent 1))
 206   ;; To contain any core dumps.
 207   `(module--with-temp-directory tempdir
 208      (with-temp-buffer
 209        (let* ((default-directory tempdir)
 210               (status (call-process mod-test-emacs nil t nil
 211                                     "-batch" "-Q" "-module-assertions" "-eval"
 212                                     ,(prin1-to-string
 213                                       `(progn
 214                                          (require 'mod-test ,mod-test-file)
 215                                          ,@body)))))
 216          (should (stringp status))
 217          ;; eg "Aborted" or "Abort trap: 6"
 218          (should (string-prefix-p "Abort" status))
 219          (search-backward "Emacs module assertion: ")
 220          (goto-char (match-end 0))
 221          (should (string-match-p ,pattern
 222                                  (buffer-substring-no-properties
 223                                   (point) (point-max))))))))
 224
 225 (ert-deftest module--test-assertions--load-non-live-object ()
 226   "Check that -module-assertions verify that non-live objects
 227 aren’t accessed."
 228   (skip-unless (file-executable-p mod-test-emacs))
 229   ;; This doesn’t yet cause undefined behavior.
 230   (should (eq (mod-test-invalid-store) 123))
 231   (module--test-assertion (rx "Emacs value not found in "
 232                               (+ digit) " values of "
 233                               (+ digit) " environments\n")
 234     ;; Storing and reloading a local value causes undefined behavior,
 235     ;; which should be detected by the module assertions.
 236     (mod-test-invalid-store)
 237     (mod-test-invalid-load)))
 238
 239 (ert-deftest module--test-assertions--call-emacs-from-gc ()
 240   "Check that -module-assertions prevents calling Emacs functions
 241 during garbage collection."
 242   (skip-unless (file-executable-p mod-test-emacs))
 243   (module--test-assertion
 244       (rx "Module function called during garbage collection\n")
 245     (mod-test-invalid-finalizer)))
 246
 247 ;;; emacs-module-tests.el ends here