mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-03 08:30:09 +00:00
Remove test/automated detritus from merge
This commit is contained in:
Paul Eggert
parent
5a59e28dec
commit
42479446d3
@ -1,98 +0,0 @@
|
||||
;;; abbrev-tests.el --- Test suite for abbrevs.
|
||||
|
||||
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eli Zaretskii <eliz@gnu.org>
|
||||
;; Keywords: abbrevs
|
||||
|
||||
;; 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/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; `kill-all-abbrevs-test' will remove all user *and* system abbrevs
|
||||
;; if called noninteractively with the init file loaded.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'abbrev)
|
||||
(require 'seq)
|
||||
|
||||
;; set up test abbrev table and abbrev entry
|
||||
(defun setup-test-abbrev-table ()
|
||||
(defvar ert-test-abbrevs nil)
|
||||
(define-abbrev-table 'ert-test-abbrevs '(("a-e-t" "abbrev-ert-test")))
|
||||
(abbrev-table-put ert-test-abbrevs :ert-test "ert-test-value")
|
||||
ert-test-abbrevs)
|
||||
|
||||
(ert-deftest copy-abbrev-table-test ()
|
||||
(defvar foo-abbrev-table nil) ; Avoid compiler warning
|
||||
(define-abbrev-table 'foo-abbrev-table
|
||||
'())
|
||||
(should (abbrev-table-p foo-abbrev-table))
|
||||
;; Bug 21828
|
||||
(let ((new-foo-abbrev-table
|
||||
(condition-case nil
|
||||
(copy-abbrev-table foo-abbrev-table)
|
||||
(error nil))))
|
||||
(should (abbrev-table-p new-foo-abbrev-table)))
|
||||
(should-not (string-equal (buffer-name) "*Backtrace*")))
|
||||
|
||||
(ert-deftest kill-all-abbrevs-test ()
|
||||
"Test undefining all defined abbrevs"
|
||||
(unless noninteractive
|
||||
(ert-skip "Cannot test kill-all-abbrevs in interactive mode"))
|
||||
|
||||
(let ((num-tables 0))
|
||||
;; ensure at least one abbrev exists
|
||||
(should (abbrev-table-p (setup-test-abbrev-table)))
|
||||
(setf num-tables (length abbrev-table-name-list))
|
||||
(kill-all-abbrevs)
|
||||
|
||||
;; no tables should have been removed/added
|
||||
(should (= num-tables (length abbrev-table-name-list)))
|
||||
;; number of empty tables should be the same as number of tables
|
||||
(should (= num-tables (length (seq-filter
|
||||
(lambda (table)
|
||||
(abbrev-table-empty-p (symbol-value table)))
|
||||
abbrev-table-name-list))))))
|
||||
|
||||
(ert-deftest abbrev-table-name-test ()
|
||||
"Test returning name of abbrev-table"
|
||||
(let ((ert-test-abbrevs (setup-test-abbrev-table))
|
||||
(no-such-table nil))
|
||||
(should (equal 'ert-test-abbrevs (abbrev-table-name ert-test-abbrevs)))
|
||||
(should (equal nil (abbrev-table-name no-such-table)))))
|
||||
|
||||
(ert-deftest clear-abbrev-table-test ()
|
||||
"Test clearing single abbrev table"
|
||||
(let ((ert-test-abbrevs (setup-test-abbrev-table)))
|
||||
(should (equal "a-e-t" (symbol-name
|
||||
(abbrev-symbol "a-e-t" ert-test-abbrevs))))
|
||||
(should (equal "abbrev-ert-test" (symbol-value
|
||||
(abbrev-symbol "a-e-t" ert-test-abbrevs))))
|
||||
|
||||
(clear-abbrev-table ert-test-abbrevs)
|
||||
|
||||
(should (equal "nil" (symbol-name
|
||||
(abbrev-symbol "a-e-t" ert-test-abbrevs))))
|
||||
(should (equal nil (symbol-value
|
||||
(abbrev-symbol "a-e-t" ert-test-abbrevs))))
|
||||
(should (equal t (abbrev-table-empty-p ert-test-abbrevs)))))
|
||||
|
||||
(provide 'abbrev-tests)
|
||||
|
||||
;;; abbrev-tests.el ends here
|
||||
@ -1,42 +0,0 @@
|
||||
;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
|
||||
|
||||
;; 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/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'cl-seq)
|
||||
|
||||
(ert-deftest cl-union-test-00 ()
|
||||
(let ((str1 "foo")
|
||||
(str2 (make-string 3 ?o)))
|
||||
;; Emacs may make two string literals eql when reading.
|
||||
(aset str2 0 ?f)
|
||||
(should (not (eql str1 str2)))
|
||||
(should (equal str1 str2))
|
||||
(should (equal (cl-union (list str1) (list str2))
|
||||
(list str2)))
|
||||
(should (equal (cl-union (list str1) (list str2) :test 'eql)
|
||||
(list str1 str2)))))
|
||||
|
||||
(provide 'cl-seq-tests)
|
||||
;;; cl-seq-tests.el ends here
|
||||
@ -1,50 +0,0 @@
|
||||
;;; coding-tests.el --- tests for text encoding and decoding
|
||||
|
||||
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
;; 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/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
;; Directory to hold test data files.
|
||||
(defvar coding-tests-workdir
|
||||
(expand-file-name "coding-tests" temporary-file-directory))
|
||||
|
||||
;; Remove all generated test files.
|
||||
(defun coding-tests-remove-files ()
|
||||
(delete-directory coding-tests-workdir t))
|
||||
|
||||
(ert-deftest ert-test-coding-bogus-coding-systems ()
|
||||
(unwind-protect
|
||||
(let (test-file)
|
||||
(or (file-directory-p coding-tests-workdir)
|
||||
(mkdir coding-tests-workdir t))
|
||||
(setq test-file (expand-file-name "nonexistent" coding-tests-workdir))
|
||||
(if (file-exists-p test-file)
|
||||
(delete-file test-file))
|
||||
(should-error
|
||||
(let ((coding-system-for-read 'bogus))
|
||||
(insert-file-contents test-file)))
|
||||
;; See bug #21602.
|
||||
(setq test-file (expand-file-name "writing" coding-tests-workdir))
|
||||
(should-error
|
||||
(let ((coding-system-for-write (intern "\"us-ascii\"")))
|
||||
(write-region "some text" nil test-file))))
|
||||
(coding-tests-remove-files)))
|
||||
@ -1,52 +0,0 @@
|
||||
;;; core-elisp-tests.el --- Testing some core Elisp rules
|
||||
|
||||
;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;; Keywords:
|
||||
|
||||
;; This program 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.
|
||||
|
||||
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(ert-deftest core-elisp-tests-1-defvar-in-let ()
|
||||
"Test some core Elisp rules."
|
||||
(with-temp-buffer
|
||||
;; Check that when defvar is run within a let-binding, the toplevel default
|
||||
;; is properly initialized.
|
||||
(should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x)
|
||||
'(1 2)))
|
||||
(should (equal (list (let ((c-e-x 1))
|
||||
(defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x)
|
||||
c-e-x)
|
||||
'(1 2)))))
|
||||
|
||||
(ert-deftest core-elisp-tests-2-window-configurations ()
|
||||
"Test properties of window-configurations."
|
||||
(let ((wc (current-window-configuration)))
|
||||
(with-current-buffer (window-buffer (frame-selected-window))
|
||||
(push-mark)
|
||||
(activate-mark))
|
||||
(set-window-configuration wc)
|
||||
(should (or (not mark-active) (mark)))))
|
||||
|
||||
(ert-deftest core-elisp-tests-3-backquote ()
|
||||
(should (eq 3 (eval ``,,'(+ 1 2)))))
|
||||
|
||||
(provide 'core-elisp-tests)
|
||||
;;; core-elisp-tests.el ends here
|
||||
@ -1,257 +0,0 @@
|
||||
;;; data-tests.el --- tests for src/data.c
|
||||
|
||||
;; Copyright (C) 2013-2017 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(ert-deftest data-tests-= ()
|
||||
(should-error (=))
|
||||
(should (= 1))
|
||||
(should (= 2 2))
|
||||
(should (= 9 9 9 9 9 9 9 9 9))
|
||||
(should-not (apply #'= '(3 8 3)))
|
||||
(should-error (= 9 9 'foo))
|
||||
;; Short circuits before getting to bad arg
|
||||
(should-not (= 9 8 'foo)))
|
||||
|
||||
(ert-deftest data-tests-< ()
|
||||
(should-error (<))
|
||||
(should (< 1))
|
||||
(should (< 2 3))
|
||||
(should (< -6 -1 0 2 3 4 8 9 999))
|
||||
(should-not (apply #'< '(3 8 3)))
|
||||
(should-error (< 9 10 'foo))
|
||||
;; Short circuits before getting to bad arg
|
||||
(should-not (< 9 8 'foo)))
|
||||
|
||||
(ert-deftest data-tests-> ()
|
||||
(should-error (>))
|
||||
(should (> 1))
|
||||
(should (> 3 2))
|
||||
(should (> 6 1 0 -2 -3 -4 -8 -9 -999))
|
||||
(should-not (apply #'> '(3 8 3)))
|
||||
(should-error (> 9 8 'foo))
|
||||
;; Short circuits before getting to bad arg
|
||||
(should-not (> 8 9 'foo)))
|
||||
|
||||
(ert-deftest data-tests-<= ()
|
||||
(should-error (<=))
|
||||
(should (<= 1))
|
||||
(should (<= 2 3))
|
||||
(should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
|
||||
(should-not (apply #'<= '(3 8 3 3)))
|
||||
(should-error (<= 9 10 'foo))
|
||||
;; Short circuits before getting to bad arg
|
||||
(should-not (<= 9 8 'foo)))
|
||||
|
||||
(ert-deftest data-tests->= ()
|
||||
(should-error (>=))
|
||||
(should (>= 1))
|
||||
(should (>= 3 2))
|
||||
(should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
|
||||
(should-not (apply #'>= '(3 8 3)))
|
||||
(should-error (>= 9 8 'foo))
|
||||
;; Short circuits before getting to bad arg
|
||||
(should-not (>= 8 9 'foo)))
|
||||
|
||||
;; Bool vector tests. Compactly represent bool vectors as hex
|
||||
;; strings.
|
||||
|
||||
(ert-deftest bool-vector-count-population-all-0-nil ()
|
||||
(cl-loop for sz in '(0 45 1 64 9 344)
|
||||
do (let* ((bv (make-bool-vector sz nil)))
|
||||
(should
|
||||
(zerop
|
||||
(bool-vector-count-population bv))))))
|
||||
|
||||
(ert-deftest bool-vector-count-population-all-1-t ()
|
||||
(cl-loop for sz in '(0 45 1 64 9 344)
|
||||
do (let* ((bv (make-bool-vector sz t)))
|
||||
(should
|
||||
(eql
|
||||
(bool-vector-count-population bv)
|
||||
sz)))))
|
||||
|
||||
(ert-deftest bool-vector-count-population-1-nil ()
|
||||
(let* ((bv (make-bool-vector 45 nil)))
|
||||
(aset bv 40 t)
|
||||
(aset bv 0 t)
|
||||
(should
|
||||
(eql
|
||||
(bool-vector-count-population bv)
|
||||
2))))
|
||||
|
||||
(ert-deftest bool-vector-count-population-1-t ()
|
||||
(let* ((bv (make-bool-vector 45 t)))
|
||||
(aset bv 40 nil)
|
||||
(aset bv 0 nil)
|
||||
(should
|
||||
(eql
|
||||
(bool-vector-count-population bv)
|
||||
43))))
|
||||
|
||||
(defun mock-bool-vector-count-consecutive (a b i)
|
||||
(loop for i from i below (length a)
|
||||
while (eq (aref a i) b)
|
||||
sum 1))
|
||||
|
||||
(defun test-bool-vector-bv-from-hex-string (desc)
|
||||
(let (bv nchars nibbles)
|
||||
(dolist (c (string-to-list desc))
|
||||
(push (string-to-number
|
||||
(char-to-string c)
|
||||
16)
|
||||
nibbles))
|
||||
(setf bv (make-bool-vector (* 4 (length nibbles)) nil))
|
||||
(let ((i 0))
|
||||
(dolist (n (nreverse nibbles))
|
||||
(dotimes (_ 4)
|
||||
(aset bv i (> (logand 1 n) 0))
|
||||
(incf i)
|
||||
(setf n (lsh n -1)))))
|
||||
bv))
|
||||
|
||||
(defun test-bool-vector-to-hex-string (bv)
|
||||
(let (nibbles (v (cl-coerce bv 'list)))
|
||||
(while v
|
||||
(push (logior
|
||||
(lsh (if (nth 0 v) 1 0) 0)
|
||||
(lsh (if (nth 1 v) 1 0) 1)
|
||||
(lsh (if (nth 2 v) 1 0) 2)
|
||||
(lsh (if (nth 3 v) 1 0) 3))
|
||||
nibbles)
|
||||
(setf v (nthcdr 4 v)))
|
||||
(mapconcat (lambda (n) (format "%X" n))
|
||||
(nreverse nibbles)
|
||||
"")))
|
||||
|
||||
(defun test-bool-vector-count-consecutive-tc (desc)
|
||||
"Run a test case for bool-vector-count-consecutive.
|
||||
DESC is a string describing the test. It is a sequence of
|
||||
hexadecimal digits describing the bool vector. We exhaustively
|
||||
test all counts at all possible positions in the vector by
|
||||
comparing the subr with a much slower lisp implementation."
|
||||
(let ((bv (test-bool-vector-bv-from-hex-string desc)))
|
||||
(loop
|
||||
for lf in '(nil t)
|
||||
do (loop
|
||||
for pos from 0 upto (length bv)
|
||||
for cnt = (mock-bool-vector-count-consecutive bv lf pos)
|
||||
for rcnt = (bool-vector-count-consecutive bv lf pos)
|
||||
unless (eql cnt rcnt)
|
||||
do (error "FAILED testcase %S %3S %3S %3S"
|
||||
pos lf cnt rcnt)))))
|
||||
|
||||
(defconst bool-vector-test-vectors
|
||||
'(""
|
||||
"0"
|
||||
"F"
|
||||
"0F"
|
||||
"F0"
|
||||
"00000000000000000000000000000FFFFF0000000"
|
||||
"44a50234053fba3340000023444a50234053fba33400000234"
|
||||
"12341234123456123412346001234123412345612341234600"
|
||||
"44a50234053fba33400000234"
|
||||
"1234123412345612341234600"
|
||||
"44a50234053fba33400000234"
|
||||
"1234123412345612341234600"
|
||||
"44a502340"
|
||||
"123412341"
|
||||
"0000000000000000000000000"
|
||||
"FFFFFFFFFFFFFFFF1"))
|
||||
|
||||
(ert-deftest bool-vector-count-consecutive ()
|
||||
(mapc #'test-bool-vector-count-consecutive-tc
|
||||
bool-vector-test-vectors))
|
||||
|
||||
(defun test-bool-vector-apply-mock-op (mock a b c)
|
||||
"Compute (slowly) the correct result of a bool-vector set operation."
|
||||
(let (changed nv)
|
||||
(assert (eql (length b) (length c)))
|
||||
(if a (setf nv a)
|
||||
(setf a (make-bool-vector (length b) nil))
|
||||
(setf changed t))
|
||||
|
||||
(loop for i below (length b)
|
||||
for mockr = (funcall mock
|
||||
(if (aref b i) 1 0)
|
||||
(if (aref c i) 1 0))
|
||||
for r = (not (= 0 mockr))
|
||||
do (progn
|
||||
(unless (eq (aref a i) r)
|
||||
(setf changed t))
|
||||
(setf (aref a i) r)))
|
||||
(if changed a)))
|
||||
|
||||
(defun test-bool-vector-binop (mock real)
|
||||
"Test a binary set operation."
|
||||
(loop for s1 in bool-vector-test-vectors
|
||||
for bv1 = (test-bool-vector-bv-from-hex-string s1)
|
||||
for vecs2 = (cl-remove-if-not
|
||||
(lambda (x) (eql (length x) (length s1)))
|
||||
bool-vector-test-vectors)
|
||||
do (loop for s2 in vecs2
|
||||
for bv2 = (test-bool-vector-bv-from-hex-string s2)
|
||||
for mock-result = (test-bool-vector-apply-mock-op
|
||||
mock nil bv1 bv2)
|
||||
for real-result = (funcall real bv1 bv2)
|
||||
do (progn
|
||||
(should (equal mock-result real-result))))))
|
||||
|
||||
(ert-deftest bool-vector-intersection-op ()
|
||||
(test-bool-vector-binop
|
||||
#'logand
|
||||
#'bool-vector-intersection))
|
||||
|
||||
(ert-deftest bool-vector-union-op ()
|
||||
(test-bool-vector-binop
|
||||
#'logior
|
||||
#'bool-vector-union))
|
||||
|
||||
(ert-deftest bool-vector-xor-op ()
|
||||
(test-bool-vector-binop
|
||||
#'logxor
|
||||
#'bool-vector-exclusive-or))
|
||||
|
||||
(ert-deftest bool-vector-set-difference-op ()
|
||||
(test-bool-vector-binop
|
||||
(lambda (a b) (logand a (lognot b)))
|
||||
#'bool-vector-set-difference))
|
||||
|
||||
(ert-deftest bool-vector-change-detection ()
|
||||
(let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef"))
|
||||
(vc2 (test-bool-vector-bv-from-hex-string "012345"))
|
||||
(vc3 (make-bool-vector (length vc1) nil))
|
||||
(c1 (bool-vector-union vc1 vc2 vc3))
|
||||
(c2 (bool-vector-union vc1 vc2 vc3)))
|
||||
(should (equal c1 (test-bool-vector-apply-mock-op
|
||||
#'logior
|
||||
nil
|
||||
vc1 vc2)))
|
||||
(should (not c2))))
|
||||
|
||||
(ert-deftest bool-vector-not ()
|
||||
(let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3"))
|
||||
(v2 (test-bool-vector-bv-from-hex-string "0000C"))
|
||||
(v3 (bool-vector-not v1)))
|
||||
(should (equal v2 v3))))
|
||||
@ -1,70 +0,0 @@
|
||||
;;; help-fns.el --- tests for help-fns.el
|
||||
|
||||
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
|
||||
;; 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/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(autoload 'help-fns-test--macro "help-fns" nil nil t)
|
||||
|
||||
(ert-deftest help-fns-test-bug17410 ()
|
||||
"Test for http://debbugs.gnu.org/17410 ."
|
||||
(describe-function 'help-fns-test--macro)
|
||||
(with-current-buffer "*Help*"
|
||||
(goto-char (point-min))
|
||||
(should (search-forward "autoloaded Lisp macro" (line-end-position)))))
|
||||
|
||||
(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x)
|
||||
"A function with a funny name.
|
||||
|
||||
\(fn XYZZY)"
|
||||
x)
|
||||
|
||||
(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x)
|
||||
"Another function with a funny name."
|
||||
x)
|
||||
|
||||
(ert-deftest help-fns-test-funny-names ()
|
||||
"Test for help with functions with funny names."
|
||||
(describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f)
|
||||
(with-current-buffer "*Help*"
|
||||
(goto-char (point-min))
|
||||
(should (search-forward
|
||||
"(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYZZY)")))
|
||||
(describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f)
|
||||
(with-current-buffer "*Help*"
|
||||
(goto-char (point-min))
|
||||
(should (search-forward
|
||||
"(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)"))))
|
||||
|
||||
(ert-deftest help-fns-test-describe-symbol ()
|
||||
"Test the `describe-symbol' function."
|
||||
;; 'describe-symbol' would originally signal an error for
|
||||
;; 'font-lock-comment-face'.
|
||||
(describe-symbol 'font-lock-comment-face)
|
||||
(with-current-buffer "*Help*"
|
||||
(should (> (point-max) 1))
|
||||
(goto-char (point-min))
|
||||
(should (looking-at "^font-lock-comment-face is "))))
|
||||
|
||||
;;; help-fns.el ends here
|
||||
@ -1,75 +0,0 @@
|
||||
;;; lexbind-tests.el --- Testing the lexbind byte-compiler
|
||||
|
||||
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;; Keywords:
|
||||
|
||||
;; This program 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.
|
||||
|
||||
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(defconst lexbind-tests
|
||||
`(
|
||||
(let ((f #'car))
|
||||
(let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
|
||||
(funcall f '(1 . 2))))
|
||||
)
|
||||
"List of expression for test.
|
||||
Each element will be executed by interpreter and with
|
||||
bytecompiled code, and their results compared.")
|
||||
|
||||
|
||||
|
||||
(defun lexbind-check-1 (pat)
|
||||
"Return non-nil if PAT is the same whether directly evalled or compiled."
|
||||
(let ((warning-minimum-log-level :emergency)
|
||||
(byte-compile-warnings nil)
|
||||
(v0 (condition-case nil
|
||||
(eval pat t)
|
||||
(error nil)))
|
||||
(v1 (condition-case nil
|
||||
(funcall (let ((lexical-binding t))
|
||||
(byte-compile `(lambda nil ,pat))))
|
||||
(error nil))))
|
||||
(equal v0 v1)))
|
||||
|
||||
(put 'lexbind-check-1 'ert-explainer 'lexbind-explain-1)
|
||||
|
||||
(defun lexbind-explain-1 (pat)
|
||||
(let ((v0 (condition-case nil
|
||||
(eval pat t)
|
||||
(error nil)))
|
||||
(v1 (condition-case nil
|
||||
(funcall (let ((lexical-binding t))
|
||||
(byte-compile (list 'lambda nil pat))))
|
||||
(error nil))))
|
||||
(format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
|
||||
pat v0 v1)))
|
||||
|
||||
(ert-deftest lexbind-tests ()
|
||||
"Test the Emacs byte compiler lexbind handling."
|
||||
(dolist (pat lexbind-tests)
|
||||
(should (lexbind-check-1 pat))))
|
||||
|
||||
|
||||
|
||||
(provide 'lexbind-tests)
|
||||
;;; lexbind-tests.el ends here
|
||||
@ -1,97 +0,0 @@
|
||||
;;; syntax-tests.el --- Testing syntax rules and basic movement -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Daniel Colascione <dancol@dancol.org>
|
||||
;; Keywords:
|
||||
|
||||
;; This program 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.
|
||||
|
||||
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
(require 'ert)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun run-up-list-test (fn data start instructions)
|
||||
(cl-labels ((posof (thing)
|
||||
(and (symbolp thing)
|
||||
(= (length (symbol-name thing)) 1)
|
||||
(- (aref (symbol-name thing) 0) ?a -1))))
|
||||
(with-temp-buffer
|
||||
(set-syntax-table (make-syntax-table))
|
||||
;; Use a syntax table in which single quote is a string
|
||||
;; character so that we can embed the test data in a lisp string
|
||||
;; literal.
|
||||
(modify-syntax-entry ?\' "\"")
|
||||
(insert data)
|
||||
(goto-char (posof start))
|
||||
(dolist (instruction instructions)
|
||||
(cond ((posof instruction)
|
||||
(funcall fn)
|
||||
(should (eql (point) (posof instruction))))
|
||||
((symbolp instruction)
|
||||
(should-error (funcall fn)
|
||||
:type instruction))
|
||||
(t (cl-assert nil nil "unknown ins")))))))
|
||||
|
||||
(defmacro define-up-list-test (name fn data start &rest expected)
|
||||
`(ert-deftest ,name ()
|
||||
(run-up-list-test ,fn ,data ',start ',expected)))
|
||||
|
||||
(define-up-list-test up-list-basic
|
||||
(lambda () (up-list))
|
||||
(or "(1 1 (1 1) 1 (1 1) 1)")
|
||||
;; abcdefghijklmnopqrstuv
|
||||
i k v scan-error)
|
||||
|
||||
(define-up-list-test up-list-with-forward-sexp-function
|
||||
(lambda ()
|
||||
(let ((forward-sexp-function
|
||||
(lambda (&optional arg)
|
||||
(let ((forward-sexp-function nil))
|
||||
(forward-sexp arg)))))
|
||||
(up-list)))
|
||||
(or "(1 1 (1 1) 1 (1 1) 1)")
|
||||
;; abcdefghijklmnopqrstuv
|
||||
i k v scan-error)
|
||||
|
||||
(define-up-list-test up-list-out-of-string
|
||||
(lambda () (up-list 1 t))
|
||||
(or "1 (1 '2 2 (2 2 2' 1) 1")
|
||||
;; abcdefghijklmnopqrstuvwxy
|
||||
o r u scan-error)
|
||||
|
||||
(define-up-list-test up-list-cross-string
|
||||
(lambda () (up-list 1 t))
|
||||
(or "(1 '2 ( 2' 1 '2 ) 2' 1)")
|
||||
;; abcdefghijklmnopqrstuvwxy
|
||||
i r u x scan-error)
|
||||
|
||||
(define-up-list-test up-list-no-cross-string
|
||||
(lambda () (up-list 1 t t))
|
||||
(or "(1 '2 ( 2' 1 '2 ) 2' 1)")
|
||||
;; abcdefghijklmnopqrstuvwxy
|
||||
i k x scan-error)
|
||||
|
||||
(define-up-list-test backward-up-list-basic
|
||||
(lambda () (backward-up-list))
|
||||
(or "(1 1 (1 1) 1 (1 1) 1)")
|
||||
;; abcdefghijklmnopqrstuv
|
||||
i f a scan-error)
|
||||
|
||||
(provide 'syntax-tests)
|
||||
;;; syntax-tests.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user