emacs-module-tests.el 10.5 KB
Newer Older
1 2
;;; Test GNU Emacs modules.

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright 2015-2018 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17

;; 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
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 25 26 27 28 29
(defconst mod-test-emacs
  (expand-file-name invocation-name invocation-directory)
  "File name of the Emacs binary currently running.")

(eval-and-compile
  (defconst mod-test-file
30
    (expand-file-name "../test/data/emacs-module/mod-test" invocation-directory)
31 32 33
    "File name of the module test file."))

(require 'mod-test mod-test-file)
34

35 36 37 38 39 40 41 42
(cl-defgeneric emacs-module-tests--generic (_))

(cl-defmethod emacs-module-tests--generic ((_ module-function))
  'module-function)

(cl-defmethod emacs-module-tests--generic ((_ user-ptr))
  'user-ptr)

43
;;
44
;; Basic tests.
45 46 47
;;

(ert-deftest mod-test-sum-test ()
Eli Zaretskii's avatar
Eli Zaretskii committed
48 49 50
  (should (= (mod-test-sum 1 2) 3))
  (let ((descr (should-error (mod-test-sum 1 2 3))))
    (should (eq (car descr) 'wrong-number-of-arguments))
51
    (should (module-function-p (nth 1 descr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
52 53
    (should (eq 0
                (string-match
54 55 56
                 (concat "#<module function "
                         "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
                         "\\|Fmod_test_sum from .*\\)>")
57
                 (prin1-to-string (nth 1 descr)))))
58 59
    (should (= (nth 2 descr) 3)))
  (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 63 64
  (should (= (mod-test-sum -1 most-positive-fixnum)
             (1- most-positive-fixnum)))
  (should (= (mod-test-sum 1 most-negative-fixnum)
65
             (1+ most-negative-fixnum)))
66 67 68
  (when (< #x1fffffff most-positive-fixnum)
    (should (= (mod-test-sum 1 #x1fffffff)
               (1+ #x1fffffff)))
69
    (should (= (mod-test-sum -1 (1+ #x1fffffff))
70
               #x1fffffff)))
71 72 73 74
  (should-error (mod-test-sum 1 most-positive-fixnum)
                :type 'overflow-error)
  (should-error (mod-test-sum -1 most-negative-fixnum)
                :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 80 81 82 83
(ert-deftest module-function-object ()
  "Extract and test the implementation of a module function.
This test needs to be changed whenever the implementation
changes."
  (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 89 90 91 92 93 94
    (should (string-match-p
             (rx bos "#<module function "
                 (or "Fmod_test_sum"
                     (and "at 0x" (+ hex-digit)))
                 (? " from " (* nonl) "mod-test" (* nonl) )
                 ">" eos)
             (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 102 103 104 105 106 107 108 109 110 111
  (should-error (mod-test-signal))
  (let (debugger-args backtrace)
    (should-error
     (let ((debugger (lambda (&rest args)
                       (setq debugger-args args
                             backtrace (with-output-to-string (backtrace)))
                       (cl-incf num-nonmacro-input-events)))
           (debug-on-signal t))
       (mod-test-signal)))
    (should (equal debugger-args '(error (error . 56))))
    (should (string-match-p
112
             (rx bol "  mod-test-signal()" eol)
113
             backtrace))))
114 115 116 117 118 119 120 121 122 123 124 125 126

(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 ()
127 128
  (should (equal (mod-test-non-local-exit-funcall
                  (lambda () (signal 'error '(32))))
129 130 131 132 133 134 135
                 '(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))))

;;
136
;; String tests.
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
;;

(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")))

;;
154
;; User-pointer tests.
155 156 157 158 159 160 161 162
;;

(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))
163
    (should (eq (emacs-module-tests--generic v) 'user-ptr))
164 165 166 167 168 169
    (should (integerp r))
    (should (= r n))))

;; TODO: try to test finalizer

;;
170
;; Vector tests.
171 172 173 174 175 176 177 178 179 180 181
;;

(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))))))
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196

(ert-deftest module--func-arity ()
  (should (equal (func-arity #'mod-test-return-t) '(1 . 1)))
  (should (equal (func-arity #'mod-test-sum) '(2 . 2))))

(ert-deftest module--help-function-arglist ()
  (should (equal (help-function-arglist #'mod-test-return-t :preserve-names)
                 '(arg1)))
  (should (equal (help-function-arglist #'mod-test-return-t)
                 '(arg1)))
  (should (equal (help-function-arglist #'mod-test-sum :preserve-names)
                 '(a b)))
  (should (equal (help-function-arglist #'mod-test-sum)
                 '(arg1 arg2))))

197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
(defmacro module--with-temp-directory (name &rest body)
  "Bind NAME to the name of a temporary directory and evaluate BODY.
NAME must be a symbol.  Delete the temporary directory after BODY
exits normally or non-locally.  NAME will be bound to the
directory name (not the directory file name) of the temporary
directory."
  (declare (indent 1))
  (cl-check-type name symbol)
  `(let ((,name (file-name-as-directory
                 (make-temp-file "emacs-module-test" :directory))))
     (unwind-protect
         (progn ,@body)
       (delete-directory ,name :recursive))))

(defmacro module--test-assertion (pattern &rest body)
  "Test that PATTERN matches the assertion triggered by BODY.
Run Emacs as a subprocess, load the test module `mod-test-file',
and evaluate BODY.  Verify that Emacs aborts and prints a module
assertion message that matches PATTERN.  PATTERN is evaluated and
must evaluate to a regular expression string."
  (declare (indent 1))
  ;; To contain any core dumps.
  `(module--with-temp-directory tempdir
     (with-temp-buffer
       (let* ((default-directory tempdir)
              (status (call-process mod-test-emacs nil t nil
223 224 225
                                    "-batch" "-Q" "-module-assertions"
                                    "-eval" "(setq w32-disable-abort-dialog t)"
                                    "-eval"
226 227 228 229
                                    ,(prin1-to-string
                                      `(progn
                                         (require 'mod-test ,mod-test-file)
                                         ,@body)))))
230 231 232 233 234 235 236 237 238
         ;; Aborting doesn't raise a signal on MS-DOS/Windows, but
         ;; rather exits with a non-zero status: 2 on MS-DOS (see
         ;; msdos.c:msdos_abort), 3 on Windows, per MSDN documentation
         ;; of 'abort'.
         (if (memq system-type '(ms-dos windows-nt))
             (should (>= status 2))
           (should (stringp status))
           ;; eg "Aborted" or "Abort trap: 6"
           (should (string-prefix-p "Abort" status)))
239 240 241 242 243 244 245
         (search-backward "Emacs module assertion: ")
         (goto-char (match-end 0))
         (should (string-match-p ,pattern
                                 (buffer-substring-no-properties
                                  (point) (point-max))))))))

(ert-deftest module--test-assertions--load-non-live-object ()
246
  "Check that -module-assertions verify that non-live objects aren't accessed."
247
  (skip-unless (file-executable-p mod-test-emacs))
248
  ;; This doesn't yet cause undefined behavior.
249
  (should (eq (mod-test-invalid-store) 123))
250 251
  (module--test-assertion (rx "Emacs value not found in "
                              (+ digit) " values of "
252
                              (+ digit) " environments\n")
253 254 255 256 257 258 259 260 261 262
    ;; Storing and reloading a local value causes undefined behavior,
    ;; which should be detected by the module assertions.
    (mod-test-invalid-store)
    (mod-test-invalid-load)))

(ert-deftest module--test-assertions--call-emacs-from-gc ()
  "Check that -module-assertions prevents calling Emacs functions
during garbage collection."
  (skip-unless (file-executable-p mod-test-emacs))
  (module--test-assertion
263
      (rx "Module function called during garbage collection\n")
264
    (mod-test-invalid-finalizer)))
265

266 267 268 269 270
(ert-deftest module/describe-function-1 ()
  "Check that Bug#30163 is fixed."
  (with-temp-buffer
    (let ((standard-output (current-buffer)))
      (describe-function-1 #'mod-test-sum)
271 272 273
      (should (equal
               (buffer-substring-no-properties 1 (point-max))
               (format "a module function in `data/emacs-module/mod-test%s'.
274 275 276

(mod-test-sum a b)

277 278 279 280 281 282 283 284 285 286
Return A + B"
                       module-file-suffix))))))

(ert-deftest module/load-history ()
  "Check that Bug#30164 is fixed."
  (load mod-test-file)
  (cl-destructuring-bind (file &rest entries) (car load-history)
    (should (equal (file-name-sans-extension file) mod-test-file))
    (should (member '(provide . mod-test) entries))
    (should (member '(defun . mod-test-sum) entries))))
287

288
;;; emacs-module-tests.el ends here