mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
fdab8a9185
These will be resubmitted as patches for review. Revert "Repair another test bollixed by aggressive optimization." This reverts commit47735e0243. Revert "Repair ab ecal test by making a variable kexical," This reverts commitca42055b0c. Revert "Complete the test set for floatfns,c." This reverts commit1b0c8d6b95. Revert "Tesrts for the portable primitives in fileio.c." This reverts commita339c6827c. Revert "Tests for primitives in coding.c and charset.c." This reverts commit5749b2e4f4. Revert "Tests for primitives from the character.c module." This reverts commitb09f8df206. Revert "Tests for the lreaf.c amd print.c primitives." This reverts commitd7a3d442b4. Revert "Tests for remaining functions iun eval.c." This reverts commitcd038e5617. Revert "Completing test coverage for dataa.c orimitives." This reverts commita6e19d6179. Revert "More correctness tesrs for orinitives from fns.c." This reverts commit40ff4512ad. Revert "More tests for edit functions, buffers, and markers." This reverts commit67e8f87562. Revert "Added more buffer/marker/editing test coverage." This reverts commit3dda4b85e8. Revert "Category/charset/coding + char-table tests." This reverts commit7a93a7b334. Revert "More test coverage improvements." This reverts commitfc7339c46d. Revert "More test coverage improvements." This reverts commit95329bf445. Revert "More test coverage improvements for ERT." This reverts commite42c579a54. Revert "Crrections to tedt coverrage extensuion after bootstrap build." This reverts commit90af3295c7. Revert "Improve test coverage of builtin predicates." This reverts commit6eb170b007. Revert "Tests for 2 marker primitives previously not covered." This reverts commit6d7f0acf9c. Revert "Tests for 7 editor primitives previously not covered." This reverts commitbb403e70ae.
591 lines
24 KiB
EmacsLisp
591 lines
24 KiB
EmacsLisp
;;; emacs-module-tests.el --- Test GNU Emacs modules. -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright 2015-2026 Free Software Foundation, Inc.
|
|
|
|
;; 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 <https://www.gnu.org/licenses/>. */
|
|
|
|
;;; Commentary:
|
|
|
|
;; Unit tests for the dynamic module facility. See Info node `(elisp)
|
|
;; Writing Dynamic Modules'. These tests make use of a small test
|
|
;; module in the "emacs-module-resources" directory.
|
|
|
|
;;; Code:
|
|
;;; Prelude
|
|
|
|
(require 'cl-lib)
|
|
(require 'ert)
|
|
(require 'ert-x)
|
|
(require 'help-fns)
|
|
(require 'subr-x)
|
|
|
|
;; Catch information for bug#50902.
|
|
(when (getenv "EMACS_EMBA_CI")
|
|
(start-process-shell-command
|
|
"*timeout*" nil (format "sleep 60; kill -ABRT %d" (emacs-pid))))
|
|
|
|
(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
|
|
(expand-file-name "../test/src/emacs-module-resources/mod-test"
|
|
invocation-directory)
|
|
"File name of the module test file."))
|
|
|
|
(require 'mod-test mod-test-file)
|
|
|
|
(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)
|
|
|
|
;;; Basic tests
|
|
|
|
(ert-deftest mod-test-sum-test ()
|
|
(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 (module-function-p (nth 1 descr)))
|
|
(should (eq 0
|
|
(string-match
|
|
(concat "#<module function "
|
|
"\\(at \\(0x\\)?[[:xdigit:]]+ "
|
|
"with data 0x1234\\( from .*\\)?"
|
|
"\\|Fmod_test_sum with data 0x1234 from .*\\)>")
|
|
(prin1-to-string (nth 1 descr)))))
|
|
(should (= (nth 2 descr) 3)))
|
|
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
|
|
(should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
|
|
;; The following tests are for 32-bit build --with-wide-int.
|
|
(should (= (mod-test-sum -1 most-positive-fixnum)
|
|
(1- most-positive-fixnum)))
|
|
(should (= (mod-test-sum 1 most-negative-fixnum)
|
|
(1+ most-negative-fixnum)))
|
|
(when (< #x1fffffff most-positive-fixnum)
|
|
(should (= (mod-test-sum 1 #x1fffffff)
|
|
(1+ #x1fffffff)))
|
|
(should (= (mod-test-sum -1 (1+ #x1fffffff))
|
|
#x1fffffff)))
|
|
(should (= (mod-test-sum 1 most-positive-fixnum)
|
|
(1+ most-positive-fixnum)))
|
|
(should (= (mod-test-sum -1 most-negative-fixnum)
|
|
(1- most-negative-fixnum))))
|
|
|
|
(ert-deftest mod-test-sum-docstring ()
|
|
(should (string= (documentation 'mod-test-sum) "Return A + B\n\n(fn a b)")))
|
|
|
|
(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 (module-function-p func))
|
|
(should (functionp func))
|
|
(should (equal (type-of func) 'module-function))
|
|
(should (eq (emacs-module-tests--generic func) 'module-function))
|
|
(should (string-match-p
|
|
(rx bos "#<module function "
|
|
(or "Fmod_test_sum"
|
|
(and "at 0x" (+ hex-digit)))
|
|
" with data 0x1234"
|
|
(? " from " (* nonl) "mod-test" (* nonl) )
|
|
">" eos)
|
|
(prin1-to-string func)))))
|
|
|
|
;;; Non-local exists (throw, signal)
|
|
|
|
(ert-deftest mod-test-non-local-exit-signal-test ()
|
|
(should-error (mod-test-signal))
|
|
(let (handler-err backtrace)
|
|
(should-error
|
|
(handler-bind
|
|
((error (lambda (err)
|
|
(setq handler-err err
|
|
backtrace (with-output-to-string (backtrace))))))
|
|
(mod-test-signal)))
|
|
(should (equal handler-err '(error 56)))
|
|
(should (string-match-p
|
|
(rx bol " mod-test-signal()" eol)
|
|
backtrace))))
|
|
|
|
(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 ()
|
|
(should (equal (mod-test-non-local-exit-funcall
|
|
(lambda () (signal 'error '(32))))
|
|
'(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))))
|
|
|
|
(ert-deftest mod-test-non-local-exit-funcall-debug-on-error ()
|
|
(let* ((debugger-entered nil)
|
|
(debugger (lambda (&rest _) (setq debugger-entered t))))
|
|
(should (equal
|
|
(let ((debug-on-error t))
|
|
(mod-test-non-local-exit-funcall
|
|
(lambda () (error "test error"))))
|
|
'(signal error ("test error"))))
|
|
(should debugger-entered)))
|
|
|
|
;;; String tests
|
|
|
|
(defun multiply-string (s n)
|
|
"Return N copies of S concatenated together."
|
|
(let ((res ""))
|
|
(dotimes (_ n)
|
|
(setq res (concat res s)))
|
|
res))
|
|
|
|
(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-globref-free-test ()
|
|
(should (eq (mod-test-globref-free 1 'a "test" 'b) 'ok)))
|
|
|
|
(ert-deftest mod-test-globref-reordered ()
|
|
(should (equal (mod-test-globref-reordered) '(t t t nil))))
|
|
|
|
(ert-deftest mod-test-string-a-to-b-test ()
|
|
(should (string= (mod-test-string-a-to-b "aaa") "bbb")))
|
|
|
|
;;; User-pointer tests
|
|
|
|
(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 (eq (emacs-module-tests--generic v) 'user-ptr))
|
|
(should (integerp r))
|
|
(should (= r n))))
|
|
|
|
;; TODO: try to test finalizer
|
|
|
|
;;; Vector tests
|
|
|
|
(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))))))
|
|
|
|
(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))))
|
|
|
|
(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.
|
|
`(ert-with-temp-directory tempdir
|
|
(with-temp-buffer
|
|
(let* ((default-directory tempdir)
|
|
(status (call-process mod-test-emacs nil t nil
|
|
"-batch" "-Q" "-module-assertions"
|
|
"-eval" "(setq w32-disable-abort-dialog t)"
|
|
"-eval"
|
|
,(prin1-to-string
|
|
`(progn
|
|
(require 'mod-test ,mod-test-file)
|
|
,@body)))))
|
|
;; 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)))
|
|
(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 ()
|
|
"Check that -module-assertions verify that non-live objects aren't accessed."
|
|
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
|
|
(skip-unless (or (file-executable-p mod-test-emacs)
|
|
(and (eq system-type 'windows-nt)
|
|
(file-executable-p (concat mod-test-emacs ".exe")))))
|
|
;; This doesn't yet cause undefined behavior.
|
|
(should (eq (mod-test-invalid-store) 123))
|
|
(module--test-assertion (rx "Emacs value not found in "
|
|
(+ digit) " values of "
|
|
(+ digit) " environments\n")
|
|
;; 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--load-non-live-object-with-global-copy ()
|
|
"Check that -module-assertions verify that non-live objects aren't accessed.
|
|
This differs from `module--test-assertions--load-non-live-object'
|
|
in that it stows away a global reference. The module assertions
|
|
should nevertheless detect the invalid load."
|
|
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
|
|
(skip-unless (or (file-executable-p mod-test-emacs)
|
|
(and (eq system-type 'windows-nt)
|
|
(file-executable-p (concat mod-test-emacs ".exe")))))
|
|
;; This doesn't yet cause undefined behavior.
|
|
(should (eq (mod-test-invalid-store-copy) 123))
|
|
(module--test-assertion (rx "Emacs value not found in "
|
|
(+ digit) " values of "
|
|
(+ digit) " environments\n")
|
|
;; Storing and reloading a local value causes undefined behavior,
|
|
;; which should be detected by the module assertions.
|
|
(mod-test-invalid-store-copy)
|
|
(mod-test-invalid-load)))
|
|
|
|
(ert-deftest module--test-assertions--call-emacs-from-gc ()
|
|
"Check that -module-assertions prevents calling Emacs functions
|
|
during garbage collection."
|
|
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
|
|
(skip-unless (or (file-executable-p mod-test-emacs)
|
|
(and (eq system-type 'windows-nt)
|
|
(file-executable-p (concat mod-test-emacs ".exe")))))
|
|
(module--test-assertion
|
|
(rx "Module function called during garbage collection\n")
|
|
(mod-test-invalid-finalizer)
|
|
(garbage-collect)))
|
|
|
|
(ert-deftest module--test-assertions--globref-invalid-free ()
|
|
"Check that -module-assertions detects invalid freeing of a
|
|
local reference."
|
|
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
|
|
(skip-unless (or (file-executable-p mod-test-emacs)
|
|
(and (eq system-type 'windows-nt)
|
|
(file-executable-p (concat mod-test-emacs ".exe")))))
|
|
(module--test-assertion
|
|
(rx "Global value was not found in list of " (+ digit) " globals")
|
|
(mod-test-globref-invalid-free)
|
|
(garbage-collect)))
|
|
|
|
(ert-deftest module/describe-function-1 ()
|
|
"Check that Bug#30163 is fixed."
|
|
(with-temp-buffer
|
|
(let ((standard-output (current-buffer))
|
|
(text-quoting-style 'grave)
|
|
(fill-column 200)) ; prevent line breaks when filling
|
|
(describe-function-1 #'mod-test-sum)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "`[^']*/src/emacs-module-resources/" nil t)
|
|
(replace-match "`src/emacs-module-resources/"))
|
|
(should (equal
|
|
(buffer-substring-no-properties 1 (point-max))
|
|
(format "a module-function in `src/emacs-module-resources/mod-test%s'.
|
|
|
|
(mod-test-sum a b)
|
|
|
|
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))))
|
|
|
|
(ert-deftest mod-test-sleep-until ()
|
|
"Check that `mod-test-sleep-until' either returns normally or quits.
|
|
Interactively, you can try hitting \\[keyboard-quit] to quit."
|
|
(skip-unless (fboundp 'mod-test-sleep-until))
|
|
(dolist (arg '(nil t))
|
|
;; Guard against some caller setting `inhibit-quit'.
|
|
(with-local-quit
|
|
(condition-case nil
|
|
(should (eq (with-local-quit
|
|
;; Because `inhibit-quit' is nil here, the next
|
|
;; form either quits or returns `finished'.
|
|
(mod-test-sleep-until
|
|
;; Interactively, run for 5 seconds to give the
|
|
;; user time to quit. In batch mode, run only
|
|
;; briefly since the user can't quit.
|
|
(time-add nil (if noninteractive 0.1 5))
|
|
;; should_quit or process_input
|
|
arg))
|
|
'finished))
|
|
(quit)))))
|
|
|
|
(ert-deftest mod-test-add-nanosecond/valid ()
|
|
(dolist (input (list
|
|
;; Some realistic examples.
|
|
(current-time) (time-to-seconds)
|
|
(encode-time 12 34 5 6 7 2019 t)
|
|
;; Various legacy timestamp forms.
|
|
'(123 456) '(123 456 789) '(123 456 789 6000)
|
|
;; Corner case: this will result in a nanosecond
|
|
;; value of 1000000000 after addition. The module
|
|
;; code should handle this correctly.
|
|
'(123 65535 999999 999000)
|
|
;; Seconds since the epoch.
|
|
123 123.45
|
|
;; New (TICKS . HZ) format.
|
|
'(123456789 . 1000000000)))
|
|
(ert-info ((format "input: %s" input))
|
|
(let ((result (mod-test-add-nanosecond input))
|
|
(desired-result
|
|
(let ((hz 1000000000))
|
|
(time-add (time-convert input hz) (cons 1 hz)))))
|
|
(should (consp result))
|
|
(should (integerp (car result)))
|
|
(should (integerp (cdr result)))
|
|
(should (plusp (cdr result)))
|
|
(should (time-equal-p result desired-result))))))
|
|
|
|
(ert-deftest mod-test-add-nanosecond/nil ()
|
|
(should (<= (float-time (mod-test-add-nanosecond nil))
|
|
(+ (float-time) 1e-9))))
|
|
|
|
(ert-deftest mod-test-add-nanosecond/invalid ()
|
|
(dolist (input '(1.0e+INF 1.0e-INF 0.0e+NaN (123) (123.45 6 7) "foo" [1 2]))
|
|
(ert-info ((format "input: %s" input))
|
|
(should-error (mod-test-add-nanosecond input)))))
|
|
|
|
(ert-deftest mod-test-nanoseconds ()
|
|
"Test truncation when converting to `struct timespec'."
|
|
(skip-unless (fboundp 'mod-test-nanoseconds))
|
|
(dolist (test-case '((0 . 0)
|
|
(-1 . -1000000000)
|
|
((1 . 1000000000) . 1)
|
|
((-1 . 1000000000) . -1)
|
|
((1 . 1000000000000) . 0)
|
|
((-1 . 1000000000000) . -1)
|
|
((999 . 1000000000000) . 0)
|
|
((-999 . 1000000000000) . -1)
|
|
((1000 . 1000000000000) . 1)
|
|
((-1000 . 1000000000000) . -1)
|
|
((0 0 0 1) . 0)
|
|
((0 0 0 -1) . -1)))
|
|
(let ((input (car test-case))
|
|
(expected (cdr test-case)))
|
|
(ert-info ((format "input: %S, expected result: %d" input expected))
|
|
(should (= (mod-test-nanoseconds input) expected))))))
|
|
|
|
(ert-deftest mod-test-double ()
|
|
(skip-unless (fboundp 'mod-test-double))
|
|
(dolist (input (list 0 1 2 -1 42 12345678901234567890
|
|
most-positive-fixnum (1+ most-positive-fixnum)
|
|
most-negative-fixnum (1- most-negative-fixnum)))
|
|
(ert-info ((format "input: %d" input))
|
|
(should (= (mod-test-double input) (* 2 input))))))
|
|
|
|
(ert-deftest module-darwin-secondary-suffix ()
|
|
"Check that on Darwin, both .so and .dylib suffixes work.
|
|
See Bug#36226."
|
|
(skip-unless (eq system-type 'darwin))
|
|
(should (member ".dylib" load-suffixes))
|
|
(should (member ".so" load-suffixes))
|
|
;; Preserve the old `load-history'. This is needed for some of the
|
|
;; other unit tests that indirectly rely on `load-history'.
|
|
(let ((load-history load-history)
|
|
(dylib (concat mod-test-file ".dylib"))
|
|
(so (concat mod-test-file ".so")))
|
|
(should (file-regular-p dylib))
|
|
(should-not (file-exists-p so))
|
|
(add-name-to-file dylib so)
|
|
(unwind-protect
|
|
(load so nil nil :nosuffix :must-suffix)
|
|
(delete-file so))))
|
|
|
|
(ert-deftest module/function-finalizer ()
|
|
"Test that module function finalizers are properly called."
|
|
;; We create and leak a couple of module functions with attached
|
|
;; finalizer. Creating only one function risks spilling it to the
|
|
;; stack, where it wouldn't be garbage-collected. However, with one
|
|
;; hundred functions, there should be at least one that's
|
|
;; unreachable.
|
|
(dotimes (_ 100)
|
|
(mod-test-make-function-with-finalizer))
|
|
(cl-destructuring-bind (valid-before invalid-before)
|
|
(mod-test-function-finalizer-calls)
|
|
(should (zerop invalid-before))
|
|
(garbage-collect)
|
|
(cl-destructuring-bind (valid-after invalid-after)
|
|
(mod-test-function-finalizer-calls)
|
|
(should (zerop invalid-after))
|
|
;; We don't require exactly 100 invocations of the finalizer,
|
|
;; but at least one.
|
|
(should (> valid-after valid-before)))))
|
|
|
|
(ert-deftest module/async-pipe ()
|
|
"Check that writing data from another thread works."
|
|
(skip-when (eq system-type 'windows-nt)) ; FIXME!
|
|
(with-temp-buffer
|
|
(let ((process (make-pipe-process :name "module/async-pipe"
|
|
:buffer (current-buffer)
|
|
:coding 'utf-8-unix
|
|
:noquery t)))
|
|
(unwind-protect
|
|
(progn
|
|
(mod-test-async-pipe process)
|
|
(should (accept-process-output process 1))
|
|
;; The string below must be identical to what
|
|
;; mod-test.c:write_to_pipe produces.
|
|
(should (equal (buffer-string) "data from thread")))
|
|
(delete-process process)))))
|
|
|
|
(ert-deftest module/interactive/return-t ()
|
|
(should (functionp (symbol-function #'mod-test-return-t)))
|
|
(should (module-function-p (symbol-function #'mod-test-return-t)))
|
|
(should-not (commandp #'mod-test-return-t))
|
|
(should-not (commandp (symbol-function #'mod-test-return-t)))
|
|
(should-not (interactive-form #'mod-test-return-t))
|
|
(should-not (interactive-form (symbol-function #'mod-test-return-t)))
|
|
(should-error (call-interactively #'mod-test-return-t)
|
|
:type 'wrong-type-argument))
|
|
|
|
(ert-deftest module/interactive/return-t-int ()
|
|
(should (functionp (symbol-function #'mod-test-return-t-int)))
|
|
(should (module-function-p (symbol-function #'mod-test-return-t-int)))
|
|
(should (commandp #'mod-test-return-t-int))
|
|
(should (commandp (symbol-function #'mod-test-return-t-int)))
|
|
(should (equal (interactive-form #'mod-test-return-t-int) '(interactive)))
|
|
(should (equal (interactive-form (symbol-function #'mod-test-return-t-int))
|
|
'(interactive)))
|
|
(should (eq (mod-test-return-t-int) t))
|
|
(should (eq (call-interactively #'mod-test-return-t-int) t)))
|
|
|
|
(ert-deftest module/interactive/identity ()
|
|
(should (functionp (symbol-function #'mod-test-identity)))
|
|
(should (module-function-p (symbol-function #'mod-test-identity)))
|
|
(should (commandp #'mod-test-identity))
|
|
(should (commandp (symbol-function #'mod-test-identity)))
|
|
(should (equal (interactive-form #'mod-test-identity) '(interactive "i")))
|
|
(should (equal (interactive-form (symbol-function #'mod-test-identity))
|
|
'(interactive "i")))
|
|
(should (eq (mod-test-identity 123) 123))
|
|
(should-not (call-interactively #'mod-test-identity)))
|
|
|
|
(ert-deftest module/unibyte ()
|
|
(let ((result (mod-test-return-unibyte)))
|
|
(should (stringp result))
|
|
(should (not (multibyte-string-p (mod-test-return-unibyte))))
|
|
(should (equal result "foo\x00zot"))))
|
|
|
|
(cl-defstruct (emacs-module-tests--variable
|
|
(:constructor nil)
|
|
(:constructor emacs-module-tests--make-variable
|
|
(name
|
|
&aux
|
|
(mutex (make-mutex name))
|
|
(condvar (make-condition-variable mutex name))))
|
|
(:copier nil))
|
|
"A variable that's protected by a mutex."
|
|
value
|
|
(mutex nil :read-only t :type mutex)
|
|
(condvar nil :read-only t :type condition-variable))
|
|
|
|
(defun emacs-module-tests--wait-for-variable (variable desired)
|
|
(with-mutex (emacs-module-tests--variable-mutex variable)
|
|
(while (not (eq (emacs-module-tests--variable-value variable) desired))
|
|
(condition-wait (emacs-module-tests--variable-condvar variable)))))
|
|
|
|
(defun emacs-module-tests--change-variable (variable new)
|
|
(with-mutex (emacs-module-tests--variable-mutex variable)
|
|
(setf (emacs-module-tests--variable-value variable) new)
|
|
(condition-notify (emacs-module-tests--variable-condvar variable) :all)))
|
|
|
|
(ert-deftest emacs-module-tests/interleaved-threads ()
|
|
(let* ((state-1 (emacs-module-tests--make-variable "1"))
|
|
(state-2 (emacs-module-tests--make-variable "2"))
|
|
(thread-1
|
|
(make-thread
|
|
(lambda ()
|
|
(emacs-module-tests--change-variable state-1 'before-module)
|
|
(mod-test-funcall
|
|
(lambda ()
|
|
(emacs-module-tests--change-variable state-1 'in-module)
|
|
(emacs-module-tests--wait-for-variable state-2 'in-module)))
|
|
(emacs-module-tests--change-variable state-1 'after-module))
|
|
"thread 1"))
|
|
(thread-2
|
|
(make-thread
|
|
(lambda ()
|
|
(emacs-module-tests--change-variable state-2 'before-module)
|
|
(emacs-module-tests--wait-for-variable state-1 'in-module)
|
|
(mod-test-funcall
|
|
(lambda ()
|
|
(emacs-module-tests--change-variable state-2 'in-module)
|
|
(emacs-module-tests--wait-for-variable state-1 'after-module)))
|
|
(emacs-module-tests--change-variable state-2 'after-module))
|
|
"thread 2")))
|
|
(thread-join thread-1)
|
|
(thread-join thread-2)))
|
|
|
|
(ert-deftest mod-test-make-string/empty ()
|
|
(dolist (multibyte '(nil t))
|
|
(ert-info ((format "Multibyte: %s" multibyte))
|
|
(let ((got (mod-test-make-string 0 multibyte)))
|
|
(should (stringp got))
|
|
(should (string-empty-p got))
|
|
(should (eq (multibyte-string-p got) multibyte))))))
|
|
|
|
(ert-deftest mod-test-make-string/nonempty ()
|
|
(dolist (multibyte '(nil t))
|
|
(ert-info ((format "Multibyte: %s" multibyte))
|
|
(let ((first (mod-test-make-string 1 multibyte))
|
|
(second (mod-test-make-string 1 multibyte)))
|
|
(should (stringp first))
|
|
(should (eql (length first) 1))
|
|
(should (eq (multibyte-string-p first) multibyte))
|
|
(should (string-equal first second))
|
|
(should-not (eq first second))))))
|
|
|
|
;;; emacs-module-tests.el ends here
|