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

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

;; 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
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
19 20 21

(require 'ert)

22 23 24
(require 'mod-test
         (expand-file-name "data/emacs-module/mod-test"
                           (getenv "EMACS_TEST_DIRECTORY")))
25 26

;;
27
;; Basic tests.
28 29 30
;;

(ert-deftest mod-test-sum-test ()
Eli Zaretskii's avatar
Eli Zaretskii committed
31 32 33 34 35 36
  (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))
    (should (stringp (nth 1 descr)))
    (should (eq 0
                (string-match
37 38 39
                 (concat "#<module function "
                         "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
                         "\\|Fmod_test_sum from .*\\)>")
Eli Zaretskii's avatar
Eli Zaretskii committed
40
                 (nth 1 descr))))
41 42
    (should (= (nth 2 descr) 3)))
  (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
43
  (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
44
  ;; The following tests are for 32-bit build --with-wide-int.
45 46 47
  (should (= (mod-test-sum -1 most-positive-fixnum)
             (1- most-positive-fixnum)))
  (should (= (mod-test-sum 1 most-negative-fixnum)
48
             (1+ most-negative-fixnum)))
49 50 51 52 53
  (when (< #x1fffffff most-positive-fixnum)
    (should (= (mod-test-sum 1 #x1fffffff)
               (1+ #x1fffffff)))
    (should (= (mod-test-sum -1 #x20000000)
               #x1fffffff)))
54 55 56 57
  (should-error (mod-test-sum 1 most-positive-fixnum)
                :type 'overflow-error)
  (should-error (mod-test-sum -1 most-negative-fixnum)
                :type 'overflow-error))
58 59 60 61

(ert-deftest mod-test-sum-docstring ()
  (should (string= (documentation 'mod-test-sum) "Return A + B")))

62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
(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)))
    (should (consp func))
    (should (equal (length func) 4))
    (should (equal (nth 0 func) 'lambda))
    (should (equal (nth 1 func) '(&rest args)))
    (should (equal (nth 2 func) "Return A + B"))
    (let ((body (nth 3 func)))
      (should (consp body))
      (should (equal (length body) 4))
      (should (equal (nth 0 body) #'apply))
      (should (equal (nth 1 body) '#'internal--module-call))
      (should (equal (nth 3 body) 'args))
      (let ((obj (nth 2 body)))
        (should (equal (type-of obj) 'module-function))
        (should (string-match-p
Eli Zaretskii's avatar
Eli Zaretskii committed
81 82 83 84 85 86
                 (rx (or "#<module function Fmod_test_sum from "
                         ;; MS-Windows doesn't allow us to get the
                         ;; function name, only the address.
                         "#<module function at 0x"
                         (one-or-more hex-digit)
                         "from ")
87 88 89
                     (* nonl) "mod-test" (* nonl) ">")
                 (prin1-to-string obj)))))))

90
;;
91
;; Non-local exists (throw, signal).
92 93 94
;;

(ert-deftest mod-test-non-local-exit-signal-test ()
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
  (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
             (rx bol "  internal--module-call(" (+ nonl) ?\) ?\n
                 "  apply(internal--module-call " (+ nonl) ?\) ?\n
                 "  mod-test-signal()" eol)
             backtrace))))
110 111 112 113 114 115 116 117 118 119 120 121 122

(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 ()
123 124
  (should (equal (mod-test-non-local-exit-funcall
                  (lambda () (signal 'error '(32))))
125 126 127 128 129 130 131
                 '(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))))

;;
132
;; String tests.
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
;;

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

;;
150
;; User-pointer tests.
151 152 153 154 155 156 157 158 159 160 161 162 163 164
;;

(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

;;
165
;; Vector tests.
166 167 168 169 170 171 172 173 174 175 176
;;

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