code.delx.au - gnu-emacs/blob - modules/mod-test/test.el

   1 ;;; Test GNU Emacs modules.
   2
   3 ;; Copyright 2015-2016 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 (add-to-list 'load-path
  23              (file-name-directory (or #$ (expand-file-name (buffer-file-name)))))
  24 (require 'mod-test)
  25
  26 ;;
  27 ;; Basic tests.
  28 ;;
  29
  30 (ert-deftest mod-test-sum-test ()
  31   (should (= (mod-test-sum 1 2) 3))
  32   (let ((descr (should-error (mod-test-sum 1 2 3))))
  33     (should (eq (car descr) 'wrong-number-of-arguments))
  34     (should (stringp (nth 1 descr)))
  35     (should (eq 0
  36                 (string-match
  37                  (concat "#<module function "
  38                          "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
  39                          "\\|Fmod_test_sum from .*\\)>")
  40                  (nth 1 descr))))
  41     (should (= (nth 2 descr) 3)))
  42   (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   (should (= (mod-test-sum -1 most-positive-fixnum)
  46              (1- most-positive-fixnum)))
  47   (should (= (mod-test-sum 1 most-negative-fixnum)
  48              (1+ most-negative-fixnum)))
  49   (when (< #x1fffffff most-positive-fixnum)
  50     (should (= (mod-test-sum 1 #x1fffffff)
  51                (1+ #x1fffffff)))
  52     (should (= (mod-test-sum -1 #x20000000)
  53                #x1fffffff)))
  54   (should-error (mod-test-sum 1 most-positive-fixnum)
  55                 :type 'overflow-error)
  56   (should-error (mod-test-sum -1 most-negative-fixnum)
  57                 :type 'overflow-error))
  58
  59 (ert-deftest mod-test-sum-docstring ()
  60   (should (string= (documentation 'mod-test-sum) "Return A + B")))
  61
  62 ;;
  63 ;; Non-local exists (throw, signal).
  64 ;;
  65
  66 (ert-deftest mod-test-non-local-exit-signal-test ()
  67   (should-error (mod-test-signal)))
  68
  69 (ert-deftest mod-test-non-local-exit-throw-test ()
  70   (should (equal
  71            (catch 'tag
  72              (mod-test-throw)
  73              (ert-fail "expected throw"))
  74            65)))
  75
  76 (ert-deftest mod-test-non-local-exit-funcall-normal ()
  77   (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
  78                  23)))
  79
  80 (ert-deftest mod-test-non-local-exit-funcall-signal ()
  81   (should (equal (mod-test-non-local-exit-funcall
  82                   (lambda () (signal 'error '(32))))
  83                  '(signal error (32)))))
  84
  85 (ert-deftest mod-test-non-local-exit-funcall-throw ()
  86   (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
  87                  '(throw tag 32))))
  88
  89 ;;
  90 ;; String tests.
  91 ;;
  92
  93 (defun multiply-string (s n)
  94   (let ((res ""))
  95     (dotimes (i n res)
  96       (setq res (concat res s)))))
  97
  98 (ert-deftest mod-test-globref-make-test ()
  99   (let ((mod-str (mod-test-globref-make))
 100         (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
 101     (garbage-collect) ;; XXX: not enough to really test but it's something..
 102     (should (string= ref-str mod-str))))
 103
 104 (ert-deftest mod-test-string-a-to-b-test ()
 105   (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
 106
 107 ;;
 108 ;; User-pointer tests.
 109 ;;
 110
 111 (ert-deftest mod-test-userptr-fun-test ()
 112   (let* ((n 42)
 113          (v (mod-test-userptr-make n))
 114          (r (mod-test-userptr-get v)))
 115
 116     (should (eq (type-of v) 'user-ptr))
 117     (should (integerp r))
 118     (should (= r n))))
 119
 120 ;; TODO: try to test finalizer
 121
 122 ;;
 123 ;; Vector tests.
 124 ;;
 125
 126 (ert-deftest mod-test-vector-test ()
 127   (dolist (s '(2 10 100 1000))
 128     (dolist (e '(42 foo "foo"))
 129       (let* ((v-ref (make-vector 2 e))
 130              (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
 131              (v-test (make-vector s nil)))
 132
 133         (should (eq (mod-test-vector-fill v-test e) t))
 134         (should (eq (mod-test-vector-eq v-test e) eq-ref))))))