test/src/emacs-module-tests.el

   1 ;;; Test GNU Emacs modules.
   2
   3 ;; Copyright 2015-2018 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 <https://www.gnu.org/licenses/>.  */
  19
  20 (require 'cl-lib)
  21 (require 'ert)
  22 (require 'help-fns)
  23
  24 (defconst mod-test-emacs
  25   (expand-file-name invocation-name invocation-directory)
  26   "File name of the Emacs binary currently running.")
  27
  28 (eval-and-compile
  29   (defconst mod-test-file
  30     (expand-file-name "../test/data/emacs-module/mod-test" invocation-directory)
  31     "File name of the module test file."))
  32
  33 (require 'mod-test mod-test-file)
  34
  35 (cl-defgeneric emacs-module-tests--generic (_))
  36
  37 (cl-defmethod emacs-module-tests--generic ((_ module-function))
  38   'module-function)
  39
  40 (cl-defmethod emacs-module-tests--generic ((_ user-ptr))
  41   'user-ptr)
  42
  43 ;;
  44 ;; Basic tests.
  45 ;;
  46
  47 (ert-deftest mod-test-sum-test ()
  48   (should (= (mod-test-sum 1 2) 3))
  49   (let ((descr (should-error (mod-test-sum 1 2 3))))
  50     (should (eq (car descr) 'wrong-number-of-arguments))
  51     (should (module-function-p (nth 1 descr)))
  52     (should (eq 0
  53                 (string-match
  54                  (concat "#<module function "
  55                          "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
  56                          "\\|Fmod_test_sum from .*\\)>")
  57                  (prin1-to-string (nth 1 descr)))))
  58     (should (= (nth 2 descr) 3)))
  59   (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
  60   (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
  61   ;; The following tests are for 32-bit build --with-wide-int.
  62   (should (= (mod-test-sum -1 most-positive-fixnum)
  63              (1- most-positive-fixnum)))
  64   (should (= (mod-test-sum 1 most-negative-fixnum)
  65              (1+ most-negative-fixnum)))
  66   (when (< #x1fffffff most-positive-fixnum)
  67     (should (= (mod-test-sum 1 #x1fffffff)
  68                (1+ #x1fffffff)))
  69     (should (= (mod-test-sum -1 (1+ #x1fffffff))
  70                #x1fffffff)))
  71   (should-error (mod-test-sum 1 most-positive-fixnum)
  72                 :type 'overflow-error)
  73   (should-error (mod-test-sum -1 most-negative-fixnum)
  74                 :type 'overflow-error))
  75
  76 (ert-deftest mod-test-sum-docstring ()
  77   (should (string= (documentation 'mod-test-sum) "Return A + B\n\n(fn a b)")))
  78
  79 (ert-deftest module-function-object ()
  80   "Extract and test the implementation of a module function.
  81 This test needs to be changed whenever the implementation
  82 changes."
  83   (let ((func (symbol-function #'mod-test-sum)))
  84     (should (module-function-p func))
  85     (should (functionp func))
  86     (should (equal (type-of func) 'module-function))
  87     (should (eq (emacs-module-tests--generic func) 'module-function))
  88     (should (string-match-p
  89              (rx bos "#<module function "
  90                  (or "Fmod_test_sum"
  91                      (and "at 0x" (+ hex-digit)))
  92                  (? " from " (* nonl) "mod-test" (* nonl) )
  93                  ">" eos)
  94              (prin1-to-string func)))))
  95
  96 ;;
  97 ;; Non-local exists (throw, signal).
  98 ;;
  99
 100 (ert-deftest mod-test-non-local-exit-signal-test ()
 101   (should-error (mod-test-signal))
 102   (let (debugger-args backtrace)
 103     (should-error
 104      (let ((debugger (lambda (&rest args)
 105                        (setq debugger-args args
 106                              backtrace (with-output-to-string (backtrace)))
 107                        (cl-incf num-nonmacro-input-events)))
 108            (debug-on-signal t))
 109        (mod-test-signal)))
 110     (should (equal debugger-args '(error (error . 56))))
 111     (should (string-match-p
 112              (rx bol "  mod-test-signal()" eol)
 113              backtrace))))
 114
 115 (ert-deftest mod-test-non-local-exit-throw-test ()
 116   (should (equal
 117            (catch 'tag
 118              (mod-test-throw)
 119              (ert-fail "expected throw"))
 120            65)))
 121
 122 (ert-deftest mod-test-non-local-exit-funcall-normal ()
 123   (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
 124                  23)))
 125
 126 (ert-deftest mod-test-non-local-exit-funcall-signal ()
 127   (should (equal (mod-test-non-local-exit-funcall
 128                   (lambda () (signal 'error '(32))))
 129                  '(signal error (32)))))
 130
 131 (ert-deftest mod-test-non-local-exit-funcall-throw ()
 132   (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
 133                  '(throw tag 32))))
 134
 135 ;;
 136 ;; String tests.
 137 ;;
 138
 139 (defun multiply-string (s n)
 140   (let ((res ""))
 141     (dotimes (i n)
 142       (setq res (concat res s)))
 143     res))
 144
 145 (ert-deftest mod-test-globref-make-test ()
 146   (let ((mod-str (mod-test-globref-make))
 147         (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
 148     (garbage-collect) ;; XXX: not enough to really test but it's something..
 149     (should (string= ref-str mod-str))))
 150
 151 (ert-deftest mod-test-string-a-to-b-test ()
 152   (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
 153
 154 ;;
 155 ;; User-pointer tests.
 156 ;;
 157
 158 (ert-deftest mod-test-userptr-fun-test ()
 159   (let* ((n 42)
 160          (v (mod-test-userptr-make n))
 161          (r (mod-test-userptr-get v)))
 162
 163     (should (eq (type-of v) 'user-ptr))
 164     (should (eq (emacs-module-tests--generic v) 'user-ptr))
 165     (should (integerp r))
 166     (should (= r n))))
 167
 168 ;; TODO: try to test finalizer
 169
 170 ;;
 171 ;; Vector tests.
 172 ;;
 173
 174 (ert-deftest mod-test-vector-test ()
 175   (dolist (s '(2 10 100 1000))
 176     (dolist (e '(42 foo "foo"))
 177       (let* ((v-ref (make-vector 2 e))
 178              (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
 179              (v-test (make-vector s nil)))
 180
 181         (should (eq (mod-test-vector-fill v-test e) t))
 182         (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
 183
 184 (ert-deftest module--func-arity ()
 185   (should (equal (func-arity #'mod-test-return-t) '(1 . 1)))
 186   (should (equal (func-arity #'mod-test-sum) '(2 . 2))))
 187
 188 (ert-deftest module--help-function-arglist ()
 189   (should (equal (help-function-arglist #'mod-test-return-t :preserve-names)
 190                  '(arg1)))
 191   (should (equal (help-function-arglist #'mod-test-return-t)
 192                  '(arg1)))
 193   (should (equal (help-function-arglist #'mod-test-sum :preserve-names)
 194                  '(a b)))
 195   (should (equal (help-function-arglist #'mod-test-sum)
 196                  '(arg1 arg2))))
 197
 198 (defmacro module--with-temp-directory (name &rest body)
 199   "Bind NAME to the name of a temporary directory and evaluate BODY.
 200 NAME must be a symbol.  Delete the temporary directory after BODY
 201 exits normally or non-locally.  NAME will be bound to the
 202 directory name (not the directory file name) of the temporary
 203 directory."
 204   (declare (indent 1))
 205   (cl-check-type name symbol)
 206   `(let ((,name (file-name-as-directory
 207                  (make-temp-file "emacs-module-test" :directory))))
 208      (unwind-protect
 209          (progn ,@body)
 210        (delete-directory ,name :recursive))))
 211
 212 (defmacro module--test-assertion (pattern &rest body)
 213   "Test that PATTERN matches the assertion triggered by BODY.
 214 Run Emacs as a subprocess, load the test module `mod-test-file',
 215 and evaluate BODY.  Verify that Emacs aborts and prints a module
 216 assertion message that matches PATTERN.  PATTERN is evaluated and
 217 must evaluate to a regular expression string."
 218   (declare (indent 1))
 219   ;; To contain any core dumps.
 220   `(module--with-temp-directory tempdir
 221      (with-temp-buffer
 222        (let* ((default-directory tempdir)
 223               (status (call-process mod-test-emacs nil t nil
 224                                     "-batch" "-Q" "-module-assertions"
 225                                     "-eval" "(setq w32-disable-abort-dialog t)"
 226                                     "-eval"
 227                                     ,(prin1-to-string
 228                                       `(progn
 229                                          (require 'mod-test ,mod-test-file)
 230                                          ,@body)))))
 231          ;; Aborting doesn't raise a signal on MS-DOS/Windows, but
 232          ;; rather exits with a non-zero status: 2 on MS-DOS (see
 233          ;; msdos.c:msdos_abort), 3 on Windows, per MSDN documentation
 234          ;; of 'abort'.
 235          (if (memq system-type '(ms-dos windows-nt))
 236              (should (>= status 2))
 237            (should (stringp status))
 238            ;; eg "Aborted" or "Abort trap: 6"
 239            (should (string-prefix-p "Abort" status)))
 240          (search-backward "Emacs module assertion: ")
 241          (goto-char (match-end 0))
 242          (should (string-match-p ,pattern
 243                                  (buffer-substring-no-properties
 244                                   (point) (point-max))))))))
 245
 246 (ert-deftest module--test-assertions--load-non-live-object ()
 247   "Check that -module-assertions verify that non-live objects aren't accessed."
 248   (skip-unless (file-executable-p mod-test-emacs))
 249   ;; This doesn't yet cause undefined behavior.
 250   (should (eq (mod-test-invalid-store) 123))
 251   (module--test-assertion (rx "Emacs value not found in "
 252                               (+ digit) " values of "
 253                               (+ digit) " environments\n")
 254     ;; Storing and reloading a local value causes undefined behavior,
 255     ;; which should be detected by the module assertions.
 256     (mod-test-invalid-store)
 257     (mod-test-invalid-load)))
 258
 259 (ert-deftest module--test-assertions--call-emacs-from-gc ()
 260   "Check that -module-assertions prevents calling Emacs functions
 261 during garbage collection."
 262   (skip-unless (file-executable-p mod-test-emacs))
 263   (module--test-assertion
 264       (rx "Module function called during garbage collection\n")
 265     (mod-test-invalid-finalizer)))
 266
 267 (ert-deftest module/describe-function-1 ()
 268   "Check that Bug#30163 is fixed."
 269   (with-temp-buffer
 270     (let ((standard-output (current-buffer)))
 271       (describe-function-1 #'mod-test-sum)
 272       (should (equal
 273                (buffer-substring-no-properties 1 (point-max))
 274                (format "a module function in `data/emacs-module/mod-test%s'.
 275
 276 (mod-test-sum a b)
 277
 278 Return A + B"
 279                        module-file-suffix))))))
 280
 281 (ert-deftest module/load-history ()
 282   "Check that Bug#30164 is fixed."
 283   (load mod-test-file)
 284   (cl-destructuring-bind (file &rest entries) (car load-history)
 285     (should (equal (file-name-sans-extension file) mod-test-file))
 286     (should (member '(provide . mod-test) entries))
 287     (should (member '(defun . mod-test-sum) entries))))
 288
 289 ;;; emacs-module-tests.el ends here