mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-05-10 15:25:04 -07:00
; Revert Eric's commits from February.
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.
This commit is contained in:
Sean Whitton
parent
838fc3547a
commit
fdab8a9185
18 changed files with 1 additions and 1630 deletions
|
|
@ -25,8 +25,6 @@
|
|||
(require 'cl-lib)
|
||||
(require 'let-alist)
|
||||
|
||||
(defvar buffer-tests--local-var :default)
|
||||
|
||||
(defun overlay-tests-start-recording-modification-hooks (overlay)
|
||||
"Start recording modification hooks on OVERLAY.
|
||||
|
||||
|
|
@ -271,76 +269,6 @@ with parameters from the *Messages* buffer modification."
|
|||
(with-temp-buffer
|
||||
(should (eq (buffer-base-buffer (current-buffer)) nil))))
|
||||
|
||||
(ert-deftest buffer-tests--basic-buffer-primitives ()
|
||||
(let ((buf (generate-new-buffer " *buffer-tests-basic*")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(should (bufferp buf))
|
||||
(should (buffer-live-p buf))
|
||||
(should (equal (buffer-name buf) " *buffer-tests-basic*"))
|
||||
(should (eq (get-buffer " *buffer-tests-basic*") buf))
|
||||
(should (eq (get-buffer buf) buf))
|
||||
(should (eq (get-buffer-create " *buffer-tests-basic*") buf))
|
||||
(with-current-buffer buf
|
||||
(insert "abc")
|
||||
(should (= (buffer-size) 3))
|
||||
(should (eq (set-buffer buf) buf)))
|
||||
(with-current-buffer buf
|
||||
(let ((new-name (rename-buffer " *buffer-tests-renamed*" t)))
|
||||
(should (equal new-name " *buffer-tests-renamed*"))
|
||||
(should (eq (get-buffer new-name) buf))))
|
||||
(should (memq buf (buffer-list))))
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf)))
|
||||
(should-not (buffer-live-p buf))))
|
||||
|
||||
(ert-deftest buffer-tests--other-buffer ()
|
||||
(let ((b1 (generate-new-buffer " *buffer-tests-ob1*"))
|
||||
(b2 (generate-new-buffer " *buffer-tests-ob2*")))
|
||||
(unwind-protect
|
||||
(with-current-buffer b1
|
||||
(let ((other (other-buffer (current-buffer) t)))
|
||||
(should (bufferp other))
|
||||
(should (buffer-live-p other))
|
||||
(should-not (eq other (current-buffer)))))
|
||||
(when (buffer-live-p b1)
|
||||
(kill-buffer b1))
|
||||
(when (buffer-live-p b2)
|
||||
(kill-buffer b2)))))
|
||||
|
||||
(ert-deftest buffer-tests--buffer-last-name ()
|
||||
(let ((buf (generate-new-buffer " *buffer-tests-last-name*")))
|
||||
(unwind-protect
|
||||
(with-current-buffer buf
|
||||
(let ((first (buffer-name)))
|
||||
(rename-buffer " *buffer-tests-last-name-2*" t)
|
||||
(should (equal (buffer-last-name) first))
|
||||
(rename-buffer " *buffer-tests-last-name-3*" t)
|
||||
(should (equal (buffer-last-name) " *buffer-tests-last-name-2*"))))
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf)))))
|
||||
|
||||
(ert-deftest buffer-tests--buffer-local-value ()
|
||||
(let ((buf1 (generate-new-buffer " *buffer-tests-local-1*"))
|
||||
(buf2 (generate-new-buffer " *buffer-tests-local-2*"))
|
||||
(old buffer-tests--local-var))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq buffer-tests--local-var :default)
|
||||
(with-current-buffer buf1
|
||||
(setq-local buffer-tests--local-var :buf1))
|
||||
(with-current-buffer buf2
|
||||
(setq-local buffer-tests--local-var :buf2))
|
||||
(should (eq (buffer-local-value 'buffer-tests--local-var buf1) :buf1))
|
||||
(should (eq (buffer-local-value 'buffer-tests--local-var buf2) :buf2))
|
||||
(should (eq (buffer-local-value 'buffer-tests--local-var (current-buffer))
|
||||
:default)))
|
||||
(setq buffer-tests--local-var old)
|
||||
(when (buffer-live-p buf1)
|
||||
(kill-buffer buf1))
|
||||
(when (buffer-live-p buf2)
|
||||
(kill-buffer buf2)))))
|
||||
|
||||
(ert-deftest buffer-tests--overlays-indirect-bug58928 ()
|
||||
(with-temp-buffer
|
||||
(insert "hello world")
|
||||
|
|
|
|||
|
|
@ -1,71 +0,0 @@
|
|||
;;; category-tests.el --- Tests for category.c -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 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/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest category-tests-category-table ()
|
||||
(let ((table (make-category-table)))
|
||||
(should (category-table-p table))
|
||||
(should (category-table-p (standard-category-table)))
|
||||
(should-not (category-table-p (make-char-table 'foo)))))
|
||||
|
||||
(ert-deftest category-tests-define-category-docstring ()
|
||||
(let ((table (make-category-table)))
|
||||
(define-category ?a "Alpha category." table)
|
||||
(should (equal (category-docstring ?a table) "Alpha category."))
|
||||
(should-error (define-category ?a "Duplicate." table))))
|
||||
|
||||
(ert-deftest category-tests-set-category-table ()
|
||||
(let ((table (make-category-table)))
|
||||
(with-temp-buffer
|
||||
(should (eq (set-category-table table) table))
|
||||
(should (eq (category-table) table)))))
|
||||
|
||||
(ert-deftest category-tests-category-set-mnemonics ()
|
||||
(let ((set (make-category-set "aZ")))
|
||||
(should (equal (category-set-mnemonics set) "Za")))
|
||||
(let ((set (make-category-set "")))
|
||||
(should (equal (category-set-mnemonics set) ""))))
|
||||
|
||||
(ert-deftest category-tests-char-category-set ()
|
||||
(let ((table (make-category-table)))
|
||||
(define-category ?a "Alpha category." table)
|
||||
(modify-category-entry ?x ?a table)
|
||||
(with-temp-buffer
|
||||
(set-category-table table)
|
||||
(let ((mnemonics (category-set-mnemonics (char-category-set ?x))))
|
||||
(should (string-match-p "a" mnemonics))))))
|
||||
|
||||
(ert-deftest category-tests-copy-category-table ()
|
||||
(let ((table (make-category-table)))
|
||||
(define-category ?a "Alpha category." table)
|
||||
(modify-category-entry ?x ?a table)
|
||||
(let ((copy (copy-category-table table)))
|
||||
(modify-category-entry ?x ?a table t)
|
||||
(with-temp-buffer
|
||||
(set-category-table copy)
|
||||
(should (equal (category-set-mnemonics (char-category-set ?x)) "a")))
|
||||
(with-temp-buffer
|
||||
(set-category-table table)
|
||||
(should (equal (category-set-mnemonics (char-category-set ?x)) ""))))))
|
||||
|
||||
(provide 'category-tests)
|
||||
;;; category-tests.el ends here
|
||||
|
|
@ -44,19 +44,4 @@
|
|||
(should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
|
||||
(should (= (string-width "הַרְבֵּה אַהֲבָה" nil 8) 4)))
|
||||
|
||||
(ert-deftest character-tests--multibyte-char-to-unibyte ()
|
||||
(should (= (multibyte-char-to-unibyte ?A) ?A))
|
||||
(should (= (multibyte-char-to-unibyte ?\N{LATIN SMALL LETTER E WITH ACUTE})
|
||||
233))
|
||||
(should (= (multibyte-char-to-unibyte ?\N{GREEK SMALL LETTER LAMDA}) -1))
|
||||
(should-error (multibyte-char-to-unibyte "A")
|
||||
:type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest character-tests--char-resolve-modifiers ()
|
||||
(should (= (char-resolve-modifiers (logior ?\C-\0 ?a)) ?\C-a))
|
||||
(should (= (char-resolve-modifiers (logior ?\S-\0 ?a)) ?A))
|
||||
(should (= (char-resolve-modifiers (logior ?\C-\0 ??)) ?\C-?))
|
||||
(let ((val (logior ?\M-\0 ?a)))
|
||||
(should (= (char-resolve-modifiers val) val))))
|
||||
|
||||
;;; character-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -25,127 +25,6 @@
|
|||
"Test `decode-char'."
|
||||
(should-error (decode-char 'ascii 0.5)))
|
||||
|
||||
(ert-deftest charset-tests-charsetp ()
|
||||
(should (charsetp 'ascii))
|
||||
(should (charsetp 'unicode))
|
||||
(should-not (charsetp 'charset-tests-no-such-charset)))
|
||||
|
||||
(ert-deftest charset-tests-charset-id-internal ()
|
||||
(let ((id (charset-id-internal 'ascii)))
|
||||
(should (integerp id))
|
||||
(should (<= 0 id))))
|
||||
|
||||
(ert-deftest charset-tests-charset-plist ()
|
||||
(let ((plist (charset-plist 'ascii)))
|
||||
(should (listp plist))
|
||||
(should (stringp (plist-get plist :short-name)))))
|
||||
|
||||
(ert-deftest charset-tests-charset-priority-list ()
|
||||
(let ((list (charset-priority-list)))
|
||||
(should (listp list))
|
||||
(should (consp list))
|
||||
(should (memq 'ascii list))
|
||||
(dolist (cs list)
|
||||
(should (charsetp cs))))
|
||||
(let ((highest (charset-priority-list t)))
|
||||
(should (symbolp highest))
|
||||
(should (charsetp highest))))
|
||||
|
||||
(ert-deftest charset-tests-charset-after ()
|
||||
(with-temp-buffer
|
||||
(insert "a")
|
||||
(goto-char (point-min))
|
||||
(should (eq (charset-after) 'ascii))
|
||||
(should-not (charset-after (1+ (point-max))))))
|
||||
|
||||
(ert-deftest charset-tests-find-charset-string ()
|
||||
(let ((charsets (find-charset-string "abc")))
|
||||
(should (memq 'ascii charsets))
|
||||
(dolist (cs charsets)
|
||||
(should (charsetp cs))))
|
||||
(let ((charsets (find-charset-string "あ")))
|
||||
(should (consp charsets))
|
||||
(dolist (cs charsets)
|
||||
(should (charsetp cs)))))
|
||||
|
||||
(ert-deftest charset-tests-find-charset-region ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(let ((charsets (find-charset-region (point-min) (point-max))))
|
||||
(should (memq 'ascii charsets))
|
||||
(dolist (cs charsets)
|
||||
(should (charsetp cs))))))
|
||||
|
||||
(ert-deftest charset-tests--map-charset-chars ()
|
||||
(let (chars)
|
||||
(map-charset-chars (lambda (range _arg)
|
||||
(setq chars (append chars
|
||||
(number-sequence
|
||||
(car range) (cdr range)))))
|
||||
'ascii nil 65 67)
|
||||
(setq chars (sort (delete-dups chars) #'<))
|
||||
(should (equal chars '(65 66 67)))))
|
||||
|
||||
(ert-deftest charset-tests--define-charset-internal-errors ()
|
||||
(should-error (define-charset-internal)))
|
||||
|
||||
(defvar charset-tests--internal-counter 0)
|
||||
|
||||
(ert-deftest charset-tests--define-charset-alias ()
|
||||
(let ((alias (intern (format "charset-tests--alias-%d"
|
||||
(setq charset-tests--internal-counter
|
||||
(1+ charset-tests--internal-counter))))))
|
||||
(define-charset-alias alias 'ascii)
|
||||
(should (charsetp alias))))
|
||||
|
||||
(ert-deftest charset-tests--set-charset-plist ()
|
||||
(let ((orig (charset-plist 'ascii)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-charset-plist 'ascii '(:charset-tests t))
|
||||
(should (equal (charset-plist 'ascii) '(:charset-tests t))))
|
||||
(set-charset-plist 'ascii orig))))
|
||||
|
||||
(ert-deftest charset-tests--unify-charset-error ()
|
||||
(should-error (unify-charset 'ascii)))
|
||||
|
||||
(ert-deftest charset-tests--get-unused-iso-final-char ()
|
||||
(let ((val (get-unused-iso-final-char 1 94)))
|
||||
(when val
|
||||
(should (<= ?0 val))
|
||||
(should (<= val ??)))))
|
||||
|
||||
(ert-deftest charset-tests--declare-equiv-charset ()
|
||||
(should-not (declare-equiv-charset 1 94 ?B 'ascii))
|
||||
(should (eq (iso-charset 1 94 ?B) 'ascii)))
|
||||
|
||||
(ert-deftest charset-tests--split-char ()
|
||||
(let ((parts (split-char ?A)))
|
||||
(should (eq (car parts) 'ascii))
|
||||
(should (equal (cdr parts) '(65)))))
|
||||
|
||||
(ert-deftest charset-tests--iso-charset ()
|
||||
(should (eq (iso-charset 1 94 ?B) 'ascii)))
|
||||
|
||||
(ert-deftest charset-tests--clear-charset-maps ()
|
||||
(should-not (clear-charset-maps)))
|
||||
|
||||
(ert-deftest charset-tests--set-charset-priority ()
|
||||
(let ((orig (charset-priority-list)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-charset-priority 'unicode)
|
||||
(should (eq (charset-priority-list t) 'unicode)))
|
||||
(apply #'set-charset-priority orig))))
|
||||
|
||||
(ert-deftest charset-tests--sort-charsets ()
|
||||
(let* ((priority (charset-priority-list))
|
||||
(a (car priority))
|
||||
(b (cadr priority)))
|
||||
(skip-unless (and a b))
|
||||
(let ((sorted (sort-charsets (list b a))))
|
||||
(should (equal sorted (list a b))))))
|
||||
|
||||
(ert-deftest charset-tests-define-charset ()
|
||||
(eval '(define-charset 'charset-tests-cs-1
|
||||
"Only used for testing"
|
||||
|
|
|
|||
|
|
@ -69,14 +69,5 @@
|
|||
(set-char-table-extra-slot tbl 1 'bar)
|
||||
(should (eq (char-table-extra-slot tbl 1) 'bar))))
|
||||
|
||||
(ert-deftest chartab-test-char-table-range ()
|
||||
(let ((tbl (make-char-table nil nil)))
|
||||
(set-char-table-range tbl '(?a . ?z) 'letters)
|
||||
(should (eq (char-table-range tbl ?a) 'letters))
|
||||
(should (eq (char-table-range tbl '(?a . ?z)) 'letters))
|
||||
(should-not (char-table-range tbl ?0))
|
||||
(set-char-table-range tbl nil 'default)
|
||||
(should (eq (char-table-range tbl nil) 'default))))
|
||||
|
||||
(provide 'chartab-tests)
|
||||
;;; chartab-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -24,10 +24,6 @@
|
|||
|
||||
(require 'ert)
|
||||
|
||||
;; Optional internal helpers (only defined with ENABLE_UTF_8_CONVERTER_TEST).
|
||||
(declare-function internal-encode-string-utf-8 "coding.c")
|
||||
(declare-function internal-decode-string-utf-8 "coding.c")
|
||||
|
||||
;; Directory to hold test data files.
|
||||
(defvar coding-tests-workdir
|
||||
(expand-file-name "coding-tests" temporary-file-directory))
|
||||
|
|
@ -425,48 +421,6 @@
|
|||
(should-not (eq (encode-coding-string s coding nil) s))
|
||||
(should (eq (encode-coding-string s coding t) s))))))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-p ()
|
||||
(should (coding-system-p nil))
|
||||
(should (coding-system-p 'utf-8))
|
||||
(should-not (coding-system-p 'coding-tests-no-such-system)))
|
||||
|
||||
(ert-deftest coding-tests-check-coding-system ()
|
||||
(should (eq (check-coding-system 'utf-8) 'utf-8))
|
||||
(should (eq (check-coding-system nil) nil))
|
||||
(should-error (check-coding-system 'coding-tests-no-such-system)
|
||||
:type 'coding-system-error))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-priority-list ()
|
||||
(let ((list (coding-system-priority-list)))
|
||||
(should (listp list))
|
||||
(should (consp list))
|
||||
(dolist (cs list)
|
||||
(should (coding-system-p cs))))
|
||||
(let ((highest (coding-system-priority-list t)))
|
||||
(should (symbolp highest))
|
||||
(should (coding-system-p highest))))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-aliases ()
|
||||
(let ((aliases (coding-system-aliases 'utf-8)))
|
||||
(should (listp aliases))
|
||||
(should (memq 'utf-8 aliases))))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-plist ()
|
||||
(let ((plist (coding-system-plist 'utf-8)))
|
||||
(should (listp plist))
|
||||
(should (plist-member plist :mnemonic))))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-put ()
|
||||
(let* ((cs 'utf-8)
|
||||
(mnemonic (plist-get (coding-system-plist cs) :mnemonic)))
|
||||
(coding-system-put cs :mnemonic mnemonic)
|
||||
(should (eq (plist-get (coding-system-plist cs) :mnemonic) mnemonic))))
|
||||
|
||||
(ert-deftest coding-tests-coding-system-eol-type ()
|
||||
(let ((eol (coding-system-eol-type 'utf-8-unix)))
|
||||
(should (integerp eol))
|
||||
(should (memq eol '(0 1 2)))))
|
||||
|
||||
|
||||
(ert-deftest coding-check-coding-systems-region ()
|
||||
(should (equal (check-coding-systems-region "aå" nil '(utf-8))
|
||||
|
|
@ -476,108 +430,5 @@
|
|||
'((iso-latin-1 3) (us-ascii 1 3))))
|
||||
(should-error (check-coding-systems-region "å" nil '(bad-coding-system))))
|
||||
|
||||
(ert-deftest coding-tests--detect-coding-string-null-byte ()
|
||||
(let ((inhibit-null-byte-detection nil))
|
||||
(should (memq 'no-conversion
|
||||
(detect-coding-string (string ?a ?\0 ?b)))))
|
||||
(let ((inhibit-null-byte-detection t))
|
||||
(should (memq 'undecided
|
||||
(detect-coding-string (string ?a ?\0 ?b))))))
|
||||
|
||||
(ert-deftest coding-tests--detect-coding-string-iso-escape ()
|
||||
(let ((s (decode-coding-string
|
||||
(unibyte-string #x1b ?$ ?B ?A ?A #x1b ?\( ?B)
|
||||
'no-conversion)))
|
||||
(let ((inhibit-iso-escape-detection nil))
|
||||
(should (memq 'iso-2022-7bit (detect-coding-string s))))
|
||||
(let ((inhibit-iso-escape-detection t))
|
||||
(should (memq 'undecided (detect-coding-string s))))))
|
||||
|
||||
(ert-deftest coding-tests--detect-coding-region ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(let ((coding (detect-coding-region (point-min) (point-max) t)))
|
||||
(should (coding-system-p coding)))))
|
||||
|
||||
(ert-deftest coding-tests--find-coding-systems-region-internal ()
|
||||
(should (eq (find-coding-systems-region-internal "abc" nil nil) t))
|
||||
(let ((result (find-coding-systems-region-internal (string #x03B1)
|
||||
nil nil)))
|
||||
(should (listp result))
|
||||
(should (memq 'utf-8 result))))
|
||||
|
||||
(ert-deftest coding-tests--decode-encode-sjis ()
|
||||
(should (equal (decode-sjis-char #x82A0) ?あ))
|
||||
(should (= (encode-sjis-char ?あ) #x82A0))
|
||||
(should-error (decode-sjis-char #x817F)))
|
||||
|
||||
(ert-deftest coding-tests--decode-encode-big5 ()
|
||||
(should (equal (decode-big5-char ?A) ?A))
|
||||
(should (= (encode-big5-char ?A) ?A))
|
||||
(should-error (decode-big5-char #xA17F)))
|
||||
|
||||
(ert-deftest coding-tests--terminal-coding-system-internal ()
|
||||
(let ((orig (terminal-coding-system)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-terminal-coding-system-internal 'utf-8 nil)
|
||||
(should (eq (terminal-coding-system) 'utf-8))
|
||||
(set-safe-terminal-coding-system-internal 'us-ascii))
|
||||
(set-terminal-coding-system-internal (or orig 'undecided) nil))))
|
||||
|
||||
(ert-deftest coding-tests--keyboard-coding-system-internal ()
|
||||
(let ((orig (keyboard-coding-system)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-keyboard-coding-system-internal 'utf-8 nil)
|
||||
(should (eq (keyboard-coding-system) 'utf-8)))
|
||||
(set-keyboard-coding-system-internal orig nil))))
|
||||
|
||||
(ert-deftest coding-tests--find-operation-coding-system ()
|
||||
(let ((file-coding-system-alist '(("foo\\.txt\\'" . utf-8))))
|
||||
(should (equal (find-operation-coding-system 'insert-file-contents
|
||||
"foo.txt")
|
||||
'(utf-8 . utf-8))))
|
||||
(let ((file-coding-system-alist '(("foo\\.txt\\'" . coding-tests--cs-fn))))
|
||||
(defun coding-tests--cs-fn (_args) 'utf-8)
|
||||
(should (equal (find-operation-coding-system 'insert-file-contents
|
||||
"foo.txt")
|
||||
'(utf-8 . utf-8)))))
|
||||
|
||||
(ert-deftest coding-tests--set-coding-system-priority ()
|
||||
(let ((orig (coding-system-priority-list)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-coding-system-priority 'utf-8)
|
||||
(should (eq (coding-system-priority-list t) 'utf-8)))
|
||||
(apply #'set-coding-system-priority orig))))
|
||||
|
||||
(defvar coding-tests--internal-counter 0)
|
||||
|
||||
(ert-deftest coding-tests--define-coding-system-internal ()
|
||||
(let* ((name (intern (format "coding-tests--raw-%d"
|
||||
(setq coding-tests--internal-counter
|
||||
(1+ coding-tests--internal-counter)))))
|
||||
(plist (list :docstring "coding-tests raw")))
|
||||
(define-coding-system-internal name ?r 'raw-text (list 'ascii)
|
||||
t nil nil nil nil ?\ t plist 'unix)
|
||||
(should (coding-system-p name))
|
||||
(should (equal (plist-get (coding-system-plist name) :docstring)
|
||||
"coding-tests raw"))
|
||||
(let ((alias (intern (format "coding-tests--raw-alias-%d"
|
||||
coding-tests--internal-counter))))
|
||||
(define-coding-system-alias alias name)
|
||||
(should (memq alias (coding-system-aliases name)))
|
||||
(should (eq (coding-system-base alias) name)))))
|
||||
|
||||
(ert-deftest coding-tests--internal-utf-8-converters ()
|
||||
(skip-unless (fboundp 'internal-encode-string-utf-8))
|
||||
(let ((enc (internal-encode-string-utf-8 "abc" nil nil nil nil nil 1))
|
||||
(dec (internal-decode-string-utf-8 "abc" nil nil nil nil nil 1)))
|
||||
(should (stringp enc))
|
||||
(should (equal enc "abc"))
|
||||
(should (stringp dec))
|
||||
(should (equal dec "abc"))))
|
||||
|
||||
(provide 'coding-tests)
|
||||
;;; coding-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -23,10 +23,6 @@
|
|||
|
||||
(require 'cl-lib)
|
||||
|
||||
(declare-function subr-native-comp-unit "data.c" (subr))
|
||||
(declare-function native-comp-unit-file "data.c" (comp-unit))
|
||||
(declare-function native-comp-unit-set-file "data.c" (comp-unit new-file))
|
||||
|
||||
(defconst data-tests--float-greater-than-fixnums (+ 1.0 most-positive-fixnum)
|
||||
"A floating-point value that is greater than all fixnums.
|
||||
It is also as small as conveniently possible, to make the tests sharper.
|
||||
|
|
@ -35,159 +31,6 @@ practical Emacs platforms, since the result is a power of 2 and
|
|||
this is exactly representable and is greater than
|
||||
`most-positive-fixnum', which is just less than a power of 2.")
|
||||
|
||||
(defvar data-tests--special-var nil
|
||||
"Variable used to test `special-variable-p'.")
|
||||
|
||||
(defvar data-tests--watch-var nil
|
||||
"Variable used to test variable watchers.")
|
||||
|
||||
(defvar data-tests--local-if-set-var :default
|
||||
"Variable used to test local-variable-if-set-p and binding locus.")
|
||||
|
||||
(ert-deftest data-tests-type-predicates ()
|
||||
(let ((sym-with-pos (position-symbol 'data-tests--sym 3)))
|
||||
(should (bare-symbol-p 'data-tests--sym))
|
||||
(should-not (bare-symbol-p sym-with-pos))
|
||||
(should-not (bare-symbol-p 42)))
|
||||
(should (char-or-string-p ?a))
|
||||
(should (char-or-string-p "a"))
|
||||
(should-not (char-or-string-p 'a))
|
||||
(should-not (char-or-string-p '(a)))
|
||||
(let ((vec [1 2])
|
||||
(ct (make-char-table 'data-tests--ct))
|
||||
(bv (make-bool-vector 3 nil)))
|
||||
(should (vector-or-char-table-p vec))
|
||||
(should (vector-or-char-table-p ct))
|
||||
(should-not (vector-or-char-table-p bv))
|
||||
(should-not (vector-or-char-table-p "x")))
|
||||
(let ((bv (bool-vector t nil t)))
|
||||
(should (bool-vector-p bv))
|
||||
(should-not (bool-vector-p [t nil]))
|
||||
(should-not (bool-vector-p "t")))
|
||||
(let ((a (bool-vector t nil t))
|
||||
(b (bool-vector t t t))
|
||||
(c (bool-vector nil nil t)))
|
||||
(should (bool-vector-subsetp a b))
|
||||
(should-not (bool-vector-subsetp b a))
|
||||
(should (bool-vector-subsetp c b))
|
||||
(should-error (bool-vector-subsetp a (bool-vector t nil))))
|
||||
(let* ((interp (eval '(lambda (x) x)))
|
||||
(bytec (byte-compile (eval '(lambda (x) x)))))
|
||||
(should (closurep interp))
|
||||
(should-not (closurep #'car))
|
||||
(should (interpreted-function-p interp))
|
||||
(should-not (interpreted-function-p bytec))
|
||||
(should-not (interpreted-function-p #'car)))
|
||||
(should (subrp (symbol-function 'car)))
|
||||
(should (subrp (symbol-function '+)))
|
||||
(should-not (subrp (lambda (x) x)))
|
||||
(should-not (subrp 'car))
|
||||
(should (special-variable-p 'data-tests--special-var))
|
||||
(should (special-variable-p 'standard-output))
|
||||
(should-not (special-variable-p 'data-tests--not-special)))
|
||||
|
||||
(ert-deftest data-tests-basic-predicates ()
|
||||
(should-not (nlistp nil))
|
||||
(should-not (nlistp '(1 2)))
|
||||
(should (nlistp 3))
|
||||
(should (nlistp "x"))
|
||||
(let ((sym-with-pos (position-symbol 'data-tests--sym 42)))
|
||||
(should (symbol-with-pos-p sym-with-pos))
|
||||
(should-not (symbol-with-pos-p 'data-tests--sym))
|
||||
(should (= (symbol-with-pos-pos sym-with-pos) 42))
|
||||
(should (eq (remove-pos-from-symbol sym-with-pos) 'data-tests--sym))
|
||||
(should (eq (remove-pos-from-symbol 'data-tests--sym) 'data-tests--sym)))
|
||||
(should (arrayp "abc"))
|
||||
(should (arrayp [1 2]))
|
||||
(should-not (arrayp '(1 2)))
|
||||
(should (sequencep '(1 2)))
|
||||
(should (sequencep nil))
|
||||
(should (sequencep "abc"))
|
||||
(should (sequencep [1 2]))
|
||||
(should-not (sequencep 'data-tests--sym))
|
||||
(with-temp-buffer
|
||||
(should (markerp (point-marker)))
|
||||
(should-not (markerp 1))))
|
||||
|
||||
(ert-deftest data-tests-subr-introspection ()
|
||||
(should (equal (subr-arity (symbol-function 'car)) '(1 . 1)))
|
||||
(should (equal (subr-arity (symbol-function 'cons)) '(2 . 2)))
|
||||
(should (equal (subr-arity (symbol-function 'list)) '(0 . many)))
|
||||
(should (equal (subr-arity (symbol-function 'if)) '(2 . unevalled)))
|
||||
(should (equal (subr-name (symbol-function 'car)) "car"))
|
||||
(should (equal (subr-name (symbol-function 'cons)) "cons"))
|
||||
(should (equal (subr-name (symbol-function 'if)) "if")))
|
||||
|
||||
(ert-deftest data-tests-symbol-plist ()
|
||||
(let* ((sym 'data-tests--plist-sym)
|
||||
(orig (symbol-plist sym)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setplist sym '(a 1 b 2))
|
||||
(should (equal (symbol-plist sym) '(a 1 b 2))))
|
||||
(setplist sym orig))))
|
||||
|
||||
(ert-deftest data-tests-subr-native-lambda-list ()
|
||||
(let ((res (subr-native-lambda-list (symbol-function 'car))))
|
||||
(should (or (eq res t) (listp res)))))
|
||||
|
||||
(ert-deftest data-tests-native-comp-unit ()
|
||||
(skip-unless (fboundp 'subr-native-comp-unit))
|
||||
(let ((unit (subr-native-comp-unit (symbol-function 'symbol-file))))
|
||||
(skip-unless unit)
|
||||
(let ((orig (native-comp-unit-file unit)))
|
||||
(native-comp-unit-set-file unit "data-tests-unit")
|
||||
(should (equal (native-comp-unit-file unit) "data-tests-unit"))
|
||||
(native-comp-unit-set-file unit orig))))
|
||||
|
||||
(ert-deftest data-tests-command-modes ()
|
||||
(defun data-tests--command () (interactive) t)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(put 'data-tests--command 'command-modes '(data-tests-mode))
|
||||
(should (equal (command-modes 'data-tests--command) '(data-tests-mode))))
|
||||
(put 'data-tests--command 'command-modes nil)
|
||||
(fmakunbound 'data-tests--command)))
|
||||
|
||||
(ert-deftest data-tests-get-variable-watchers ()
|
||||
(let ((watcher (lambda (&rest _args) nil)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(add-variable-watcher 'data-tests--watch-var watcher)
|
||||
(should (member watcher (get-variable-watchers 'data-tests--watch-var))))
|
||||
(remove-variable-watcher 'data-tests--watch-var watcher)
|
||||
(should-not (get-variable-watchers 'data-tests--watch-var)))))
|
||||
|
||||
(ert-deftest data-tests-local-variable-if-set-p ()
|
||||
(with-temp-buffer
|
||||
(should-not (local-variable-if-set-p 'data-tests--local-if-set-var))
|
||||
(setq-local data-tests--local-if-set-var :local)
|
||||
(should (local-variable-if-set-p 'data-tests--local-if-set-var))))
|
||||
|
||||
(ert-deftest data-tests-variable-binding-locus ()
|
||||
(with-temp-buffer
|
||||
(should-not (variable-binding-locus 'data-tests--local-if-set-var))
|
||||
(setq-local data-tests--local-if-set-var :local)
|
||||
(should (eq (variable-binding-locus 'data-tests--local-if-set-var)
|
||||
(current-buffer)))))
|
||||
|
||||
(ert-deftest data-tests-indirect-function ()
|
||||
(defun data-tests--if-target () 'ok)
|
||||
(defalias 'data-tests--if-alias 'data-tests--if-target)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(should (eq (indirect-function 'data-tests--if-alias)
|
||||
(symbol-function 'data-tests--if-target)))
|
||||
(let ((fun (lambda (x) x)))
|
||||
(should (eq (indirect-function fun) fun))))
|
||||
(fmakunbound 'data-tests--if-alias)
|
||||
(fmakunbound 'data-tests--if-target)))
|
||||
|
||||
(ert-deftest data-tests-byteorder ()
|
||||
(let ((bo (byteorder)))
|
||||
(should (integerp bo))
|
||||
(should (memq bo (list ?B ?l)))))
|
||||
|
||||
(ert-deftest data-tests-= ()
|
||||
(should-error (=))
|
||||
(should (= 1))
|
||||
|
|
@ -852,19 +695,12 @@ comparing the subr with a much slower Lisp implementation."
|
|||
(should (/= b-1 0.0e+NaN))))
|
||||
|
||||
(ert-deftest data-tests-+ ()
|
||||
(should (= (+) 0))
|
||||
(should (= (+ 5) 5))
|
||||
(should-not (fixnump (+ most-positive-fixnum most-positive-fixnum)))
|
||||
(should (> (+ most-positive-fixnum most-positive-fixnum) most-positive-fixnum))
|
||||
(should (eq (- (+ most-positive-fixnum most-positive-fixnum)
|
||||
(+ most-positive-fixnum most-positive-fixnum))
|
||||
0)))
|
||||
|
||||
(ert-deftest data-tests-* ()
|
||||
(should (= (*) 1))
|
||||
(should (= (* 7) 7))
|
||||
(should (= (* 2 3 4) 24)))
|
||||
|
||||
(ert-deftest data-tests-/ ()
|
||||
(let* ((x (* most-positive-fixnum 8))
|
||||
(y (* most-negative-fixnum 8))
|
||||
|
|
@ -912,26 +748,6 @@ comparing the subr with a much slower Lisp implementation."
|
|||
(ert-deftest data-tests-logcount-2 ()
|
||||
(should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128)))
|
||||
|
||||
(ert-deftest data-tests-logcount-negative-bignum ()
|
||||
(let ((n (- (ash 1 200))))
|
||||
(should (bignump n))
|
||||
(should (= (logcount n) (logcount (lognot n))))))
|
||||
|
||||
(ert-deftest data-tests-lognot-bignum ()
|
||||
(let ((n (ash 1 200))
|
||||
(m (- (ash 1 180))))
|
||||
(should (bignump n))
|
||||
(should (bignump m))
|
||||
(should (= (lognot n) (- -1 n)))
|
||||
(should (= (lognot m) (- -1 m)))))
|
||||
|
||||
(ert-deftest data-tests-bignum-bit-identities ()
|
||||
(let ((n (1+ most-positive-fixnum)))
|
||||
(should (bignump n))
|
||||
(should (= (logand n (lognot n)) 0))
|
||||
(should (= (logior n (lognot n)) -1))
|
||||
(should (= (logxor n n) 0))))
|
||||
|
||||
(ert-deftest data-tests-logior ()
|
||||
(should (= -1 (logior -1) (logior -1 -1)))
|
||||
(should (= -1 (logior most-positive-fixnum most-negative-fixnum))))
|
||||
|
|
@ -965,21 +781,6 @@ comparing the subr with a much slower Lisp implementation."
|
|||
(data-tests-check-sign (% -1 -3) (% nb1 nb3))
|
||||
(data-tests-check-sign (mod -1 -3) (mod nb1 nb3))))
|
||||
|
||||
(ert-deftest data-tests-bignum-remainder-invariants ()
|
||||
(let* ((b (1+ most-positive-fixnum))
|
||||
(d 7)
|
||||
(r (mod b d)))
|
||||
(should (= b (+ (* d (floor (/ b d))) r)))
|
||||
(should (<= 0 r))
|
||||
(should (< r (abs d))))
|
||||
(let* ((b (- (1+ most-positive-fixnum)))
|
||||
(d 7)
|
||||
(q (/ b d))
|
||||
(r (% b d)))
|
||||
(should (= b (+ (* q d) r)))
|
||||
(should (<= r 0))
|
||||
(should (> r (- (abs d))))))
|
||||
|
||||
(ert-deftest data-tests-mod-0 ()
|
||||
(dolist (num (list (1- most-negative-fixnum) -1 0 1
|
||||
(1+ most-positive-fixnum)))
|
||||
|
|
|
|||
|
|
@ -132,142 +132,6 @@
|
|||
"Number of args for `propertize' must be odd."
|
||||
(should-error (propertize "foo" 'bar) :type 'wrong-number-of-arguments))
|
||||
|
||||
(ert-deftest editfns-tests--char-to-string-and-string-to-char ()
|
||||
(should (equal (char-to-string ?A) "A"))
|
||||
(should (= (string-to-char "A") ?A))
|
||||
(should (= (string-to-char "") 0))
|
||||
(should-error (char-to-string "A")))
|
||||
|
||||
(ert-deftest editfns-tests--char-equal ()
|
||||
(with-temp-buffer
|
||||
(let ((case-fold-search nil))
|
||||
(should (char-equal ?a ?a))
|
||||
(should-not (char-equal ?a ?A))
|
||||
(should-not (char-equal ?a ?b)))
|
||||
(let ((case-fold-search t))
|
||||
(should (char-equal ?a ?A))
|
||||
(should (char-equal ?A ?a))
|
||||
(should-not (char-equal ?a ?b)))))
|
||||
|
||||
(ert-deftest editfns-tests--point-and-goto-char ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(goto-char (point-min))
|
||||
(should (= (point) (point-min)))
|
||||
(should (= (goto-char 2) 2))
|
||||
(should (= (point) 2))
|
||||
(let ((m (point-marker)))
|
||||
(should (= (marker-position m) 2))
|
||||
(goto-char 3)
|
||||
(should (= (point) 3)))))
|
||||
|
||||
(ert-deftest editfns-tests--point-min-max-and-buffer-size ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(should (= (point-min) 1))
|
||||
(should (= (point-max) (1+ (buffer-size))))))
|
||||
|
||||
(ert-deftest editfns-tests--region-beginning-end ()
|
||||
(with-temp-buffer
|
||||
(insert "abcd")
|
||||
(goto-char 3)
|
||||
(let ((mark-even-if-inactive t))
|
||||
(set-mark 1)
|
||||
(should (= (region-beginning) 1))
|
||||
(should (= (region-end) 3))
|
||||
(should (eq (marker-buffer (mark-marker)) (current-buffer)))
|
||||
(should (= (marker-position (mark-marker)) 1)))))
|
||||
|
||||
(ert-deftest editfns-tests--buffer-string-compare-substrings ()
|
||||
(let ((buf1 (generate-new-buffer " *editfns-tests-cmp-1*"))
|
||||
(buf2 (generate-new-buffer " *editfns-tests-cmp-2*")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-current-buffer buf1
|
||||
(insert "abc")
|
||||
(should (equal (buffer-string) "abc")))
|
||||
(with-current-buffer buf2
|
||||
(insert "abd"))
|
||||
(let ((case-fold-search nil))
|
||||
(should (= (compare-buffer-substrings buf1 1 4 buf1 1 4) 0))
|
||||
(should (= (compare-buffer-substrings buf1 1 4 buf2 1 4) -3))))
|
||||
(when (buffer-live-p buf1)
|
||||
(kill-buffer buf1))
|
||||
(when (buffer-live-p buf2)
|
||||
(kill-buffer buf2)))))
|
||||
|
||||
(ert-deftest editfns-tests--gap-position-size ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(goto-char 2)
|
||||
(insert "Z")
|
||||
(should (integerp (gap-position)))
|
||||
(should (integerp (gap-size)))
|
||||
(should (>= (gap-size) 0))
|
||||
(should (<= (point-min) (gap-position) (point-max)))
|
||||
(should (= (gap-position) (point)))))
|
||||
|
||||
(ert-deftest editfns-tests--internal-labeled-narrow-widen ()
|
||||
(with-temp-buffer
|
||||
(insert "abcdef")
|
||||
(internal--labeled-narrow-to-region 2 6 'label)
|
||||
(should (equal (buffer-substring (point-min) (point-max)) "bcde"))
|
||||
;; Attempt to widen beyond labeled restriction should be clamped.
|
||||
(narrow-to-region 1 7)
|
||||
(should (equal (buffer-substring (point-min) (point-max)) "bcde"))
|
||||
;; Narrowing further within the labeled restriction is allowed.
|
||||
(narrow-to-region 3 5)
|
||||
(should (equal (buffer-substring (point-min) (point-max)) "cd"))
|
||||
(internal--labeled-widen 'label)
|
||||
(should (equal (buffer-substring (point-min) (point-max)) "abcdef"))))
|
||||
|
||||
(ert-deftest editfns-tests--subst-char-in-region ()
|
||||
(with-temp-buffer
|
||||
(insert "ababa")
|
||||
(subst-char-in-region (point-min) (point-max) ?b ?x)
|
||||
(should (equal (buffer-string) "axaxa"))))
|
||||
|
||||
(ert-deftest editfns-tests--line-boundaries ()
|
||||
(with-temp-buffer
|
||||
(insert "ab\ncd\n")
|
||||
(goto-char (point-min))
|
||||
(should (bobp))
|
||||
(should (bolp))
|
||||
(should-not (eobp))
|
||||
(should (= (line-beginning-position) (point-min)))
|
||||
(should (= (line-end-position) 3))
|
||||
(forward-char 1)
|
||||
(should-not (bolp))
|
||||
(should-not (eolp))
|
||||
(goto-char (line-end-position))
|
||||
(should (eolp))
|
||||
(forward-char 1)
|
||||
(should (bolp))
|
||||
(goto-char (point-max))
|
||||
(should (eobp))
|
||||
(should-not (bobp))))
|
||||
|
||||
(ert-deftest editfns-tests--current-column-move-to-column ()
|
||||
(with-temp-buffer
|
||||
(insert "ab cd\n")
|
||||
(goto-char (point-min))
|
||||
(should (= (current-column) 0))
|
||||
(move-to-column 4)
|
||||
(should (= (current-column) 4))
|
||||
(should (= (point) (+ (point-min) 4)))))
|
||||
|
||||
(ert-deftest editfns-tests--pos-bol-eol ()
|
||||
(with-temp-buffer
|
||||
(insert "ab\ncde\nf")
|
||||
(goto-char (point-min))
|
||||
(forward-char 1)
|
||||
(should (= (pos-bol) (point-min)))
|
||||
(should (= (pos-eol) 3))
|
||||
(should (= (pos-bol 2) 4))
|
||||
(should (= (pos-eol 2) 7))
|
||||
(should (= (pos-bol 3) 8))
|
||||
(should (= (pos-eol 3) 9))))
|
||||
|
||||
;; Tests for bug#5131.
|
||||
(defun transpose-test-reverse-word (start end)
|
||||
"Reverse characters in a word by transposing pairs of characters."
|
||||
|
|
@ -1074,176 +938,4 @@ sufficiently large to avoid truncation."
|
|||
(pos-bol 2) (pos-eol 2))
|
||||
(should (equal (buffer-string) "toto\nEmacs forever!\n"))))
|
||||
|
||||
;; Additional coverage for editfns primitives used in batch mode.
|
||||
|
||||
(ert-deftest editfns-tests--byte-to-position ()
|
||||
(with-temp-buffer
|
||||
(insert "éa")
|
||||
(let* ((b1 (position-bytes 1))
|
||||
(b2 (position-bytes 2)))
|
||||
(should (= b1 1))
|
||||
(should (> b2 b1))
|
||||
(should (= (byte-to-position b1) 1))
|
||||
(should (= (byte-to-position b2) 2))
|
||||
;; Byte position in the middle of a multibyte character maps back
|
||||
;; to the character head.
|
||||
(should (= (byte-to-position (1- b2)) 1))
|
||||
(should-not (byte-to-position 0))
|
||||
(should-not (byte-to-position (1+ (position-bytes (point-max))))))))
|
||||
|
||||
(ert-deftest editfns-tests--byte-to-string ()
|
||||
(let ((s (byte-to-string 65)))
|
||||
(should (stringp s))
|
||||
(should (not (multibyte-string-p s)))
|
||||
(should (= (length s) 1))
|
||||
(should (= (aref s 0) 65)))
|
||||
(should-error (byte-to-string -1))
|
||||
(should-error (byte-to-string 256)))
|
||||
|
||||
(ert-deftest editfns-tests--insert-byte ()
|
||||
(with-temp-buffer
|
||||
(insert-byte ?A 3)
|
||||
(should (equal (buffer-string) "AAA")))
|
||||
(with-temp-buffer
|
||||
(insert-byte 200 1)
|
||||
(should (= (aref (buffer-string) 0)
|
||||
(unibyte-char-to-multibyte 200))))
|
||||
(should-error (with-temp-buffer (insert-byte 256 1))))
|
||||
|
||||
(ert-deftest editfns-tests--insert-buffer-substring ()
|
||||
(with-temp-buffer
|
||||
(let ((source (current-buffer)))
|
||||
(insert "abcDEF")
|
||||
(put-text-property 4 6 'foo t)
|
||||
(with-temp-buffer
|
||||
(insert "X")
|
||||
(insert-buffer-substring source 2 5)
|
||||
(should (equal (buffer-string) "XbcD"))
|
||||
(should-not (get-text-property 2 'foo))
|
||||
(should (get-text-property 4 'foo))))))
|
||||
|
||||
(ert-deftest editfns-tests--insert-before-markers-and-inherit ()
|
||||
(with-temp-buffer
|
||||
(insert (propertize "a" 'foo t))
|
||||
(let ((m (point-marker)))
|
||||
(insert-before-markers-and-inherit "b")
|
||||
(should (equal (buffer-string) "ab"))
|
||||
(should (= (marker-position m) (point)))
|
||||
(should (eq (get-text-property 2 'foo) t)))))
|
||||
|
||||
(ert-deftest editfns-tests--field-string-and-delete ()
|
||||
(with-temp-buffer
|
||||
(insert "abcDEFghi")
|
||||
(put-text-property 1 4 'field 'a)
|
||||
(put-text-property 4 7 'field 'b)
|
||||
(put-text-property 7 10 'field 'c)
|
||||
(let ((s (field-string-no-properties 2)))
|
||||
(should (equal s "abc"))
|
||||
(should-not (text-properties-at 0 s)))
|
||||
(should (equal (field-string-no-properties 5) "DEF"))
|
||||
(delete-field 5)
|
||||
(should (equal (buffer-string) "abcghi"))
|
||||
(should (equal (field-string-no-properties 5) "ghi"))))
|
||||
|
||||
(ert-deftest editfns-tests--constrain-to-field ()
|
||||
(let ((inhibit-field-text-motion nil))
|
||||
(with-temp-buffer
|
||||
(insert "abcDEFghi")
|
||||
(put-text-property 1 4 'field 'a)
|
||||
(put-text-property 4 7 'field 'b)
|
||||
(put-text-property 7 10 'field 'c)
|
||||
(should (= (constrain-to-field 2 5) 4))
|
||||
(should (= (constrain-to-field 8 5) 7))
|
||||
(goto-char 2)
|
||||
(should (= (constrain-to-field nil 5) 4))
|
||||
(should (= (point) 4)))))
|
||||
|
||||
(ert-deftest editfns-tests--char-before-after ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(goto-char (point-min))
|
||||
(should-not (char-before))
|
||||
(should (eq (char-after) ?a))
|
||||
(should (eq (char-after 1) ?a))
|
||||
(should-not (char-after 0))
|
||||
(goto-char (point-max))
|
||||
(should-not (char-after))
|
||||
(should (eq (char-before) ?c))
|
||||
(should (eq (char-before (point-max)) ?c))
|
||||
(should-not (char-before (1+ (point-max))))
|
||||
(narrow-to-region 2 3)
|
||||
(goto-char (point-min))
|
||||
(should-not (char-before))
|
||||
(should (eq (char-after) ?b))
|
||||
(goto-char (point-max))
|
||||
(should-not (char-after))
|
||||
(should (eq (char-before) ?b))))
|
||||
|
||||
(ert-deftest editfns-tests--following-preceding-char ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(goto-char (point-min))
|
||||
(should (= (following-char) ?a))
|
||||
(should (= (preceding-char) 0))
|
||||
(goto-char (point-max))
|
||||
(should (= (following-char) 0))
|
||||
(should (= (preceding-char) ?c))
|
||||
(narrow-to-region 2 3)
|
||||
(goto-char (point-min))
|
||||
(should (= (preceding-char) 0))
|
||||
(goto-char (point-max))
|
||||
(should (= (following-char) 0))))
|
||||
|
||||
(ert-deftest editfns-tests--buffer-substring-properties ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(add-text-properties (point-min) (point-max) '(foo bar))
|
||||
(let ((with-props (buffer-substring (point-min) (point-max)))
|
||||
(without-props (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(should (equal with-props "abc"))
|
||||
(should (equal without-props "abc"))
|
||||
(should (eq (get-text-property 0 'foo with-props) 'bar))
|
||||
(should-not (get-text-property 0 'foo without-props)))))
|
||||
|
||||
(ert-deftest editfns-tests--insert-and-inherit ()
|
||||
(with-temp-buffer
|
||||
(insert "a")
|
||||
(add-text-properties 1 2 '(foo bar))
|
||||
(goto-char (point-max))
|
||||
(insert "b")
|
||||
(should-not (get-text-property 2 'foo))
|
||||
(erase-buffer))
|
||||
(with-temp-buffer
|
||||
(insert "a")
|
||||
(add-text-properties 1 2 '(foo bar))
|
||||
(goto-char (point-max))
|
||||
(insert-and-inherit "b")
|
||||
(should (eq (get-text-property 2 'foo) 'bar))))
|
||||
|
||||
(ert-deftest editfns-tests--line-beginning-end-position ()
|
||||
(with-temp-buffer
|
||||
(insert "aa\nbb\ncc")
|
||||
(goto-char 5)
|
||||
(should (= (line-beginning-position) 4))
|
||||
(should (= (line-end-position) 6))
|
||||
(should (= (line-beginning-position 2) 7))
|
||||
(should (= (line-end-position 2) (point-max)))
|
||||
(goto-char (point-min))
|
||||
(should (= (line-beginning-position 5) (point-max)))
|
||||
(should (= (line-end-position 5) (point-max)))))
|
||||
|
||||
(ert-deftest editfns-tests--current-column ()
|
||||
(with-temp-buffer
|
||||
(let ((tab-width 4))
|
||||
(insert "ab\tcd")
|
||||
(goto-char (point-min))
|
||||
(should (= (current-column) 0))
|
||||
(forward-char 2)
|
||||
(should (= (current-column) 2))
|
||||
(forward-char 1)
|
||||
(should (= (current-column) 4))
|
||||
(forward-char 2)
|
||||
(should (= (current-column) 6)))))
|
||||
|
||||
;;; editfns-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -192,13 +192,6 @@ changes."
|
|||
(should (integerp r))
|
||||
(should (= r n))))
|
||||
|
||||
(ert-deftest mod-test-userptrp ()
|
||||
(skip-unless (fboundp 'user-ptrp))
|
||||
(let ((v (mod-test-userptr-make 7)))
|
||||
(should (user-ptrp v))
|
||||
(should-not (user-ptrp 7))
|
||||
(should-not (user-ptrp "x"))))
|
||||
|
||||
;; TODO: try to test finalizer
|
||||
|
||||
;;; Vector tests
|
||||
|
|
|
|||
|
|
@ -374,22 +374,6 @@ expressions works for identifiers starting with period."
|
|||
(error err))))
|
||||
(should (eq inner-error outer-error))))
|
||||
|
||||
(ert-deftest eval-tests--condition-case-basic ()
|
||||
(should (equal (condition-case err
|
||||
42
|
||||
(error (list 'err err)))
|
||||
42))
|
||||
(should (equal (condition-case err
|
||||
(signal 'wrong-type-argument '(integerp "x"))
|
||||
(wrong-type-argument (list 'wt err))
|
||||
(error (list 'err err)))
|
||||
'(wt (wrong-type-argument integerp "x"))))
|
||||
(should (equal (condition-case err
|
||||
(signal 'error '("boom"))
|
||||
(wrong-type-argument (list 'wt err))
|
||||
(error (list 'err err)))
|
||||
'(err (error "boom")))))
|
||||
|
||||
(ert-deftest eval-bad-specbind ()
|
||||
(should-error (eval '(let (((a b) 23)) (+ 1 2)) t)
|
||||
:type 'wrong-type-argument)
|
||||
|
|
@ -399,160 +383,4 @@ expressions works for identifiers starting with period."
|
|||
:type 'wrong-type-argument)
|
||||
(should-error (eval '(funcall '(lambda ((a b) 3.15) 84) 5 4))))
|
||||
|
||||
(ert-deftest eval-tests--make-interpreted-closure ()
|
||||
(let* ((env (list (cons 'y 40)))
|
||||
(closure (make-interpreted-closure '(x)
|
||||
(list '(+ x y))
|
||||
env
|
||||
"doc"
|
||||
nil)))
|
||||
(should (closurep closure))
|
||||
(should (= (funcall closure 2) 42))
|
||||
(should (equal (documentation closure t) "doc"))
|
||||
(should-not (commandp closure)))
|
||||
(let ((closure (make-interpreted-closure '()
|
||||
(list '(+ 1 1))
|
||||
nil
|
||||
nil
|
||||
'(interactive "p"))))
|
||||
(should (commandp closure))
|
||||
(should (equal (interactive-form closure) '(interactive "p")))))
|
||||
|
||||
(ert-deftest eval-tests--internal-define-uninitialized-variable ()
|
||||
(let ((sym (make-symbol "eval-tests--uninit-var")))
|
||||
(should-not (boundp sym))
|
||||
(internal--define-uninitialized-variable sym "doc")
|
||||
(should-not (boundp sym))
|
||||
(should (special-variable-p sym))
|
||||
(should (equal (documentation-property sym 'variable-documentation) "doc")))
|
||||
(let ((sym (make-symbol "eval-tests--uninit-var-keep")))
|
||||
(set sym 'value)
|
||||
(internal--define-uninitialized-variable sym "doc")
|
||||
(should (eq (symbol-value sym) 'value))))
|
||||
|
||||
(ert-deftest eval-tests--defvar-1 ()
|
||||
(let ((sym (make-symbol "eval-tests--defvar-1")))
|
||||
(defvar-1 sym 'init "doc")
|
||||
(should (eq (symbol-value sym) 'init))
|
||||
(should (special-variable-p sym))
|
||||
(should (equal (documentation-property sym 'variable-documentation) "doc"))
|
||||
(set sym 'old)
|
||||
(defvar-1 sym 'new "doc2")
|
||||
(should (eq (symbol-value sym) 'old))))
|
||||
|
||||
(ert-deftest eval-tests--defconst-1 ()
|
||||
(let ((sym (make-symbol "eval-tests--defconst-1")))
|
||||
(set sym 'old)
|
||||
(defconst-1 sym 'new "doc")
|
||||
(should (eq (symbol-value sym) 'new))
|
||||
(should (special-variable-p sym))
|
||||
(should (equal (documentation-property sym 'variable-documentation) "doc"))
|
||||
(should (eq (get sym 'risky-local-variable) t))))
|
||||
|
||||
(ert-deftest eval-tests--internal-make-var-non-special ()
|
||||
(let ((sym (make-symbol "eval-tests--non-special")))
|
||||
(defvar-1 sym 'init nil)
|
||||
(should (special-variable-p sym))
|
||||
(internal-make-var-non-special sym)
|
||||
(should-not (special-variable-p sym))))
|
||||
|
||||
(ert-deftest eval-tests--handler-bind-1 ()
|
||||
(let (seen)
|
||||
(should (equal (catch 'hb
|
||||
(handler-bind-1
|
||||
(lambda () (error "boom"))
|
||||
'error
|
||||
(lambda (err)
|
||||
(setq seen err)
|
||||
(throw 'hb 'handled))))
|
||||
'handled))
|
||||
(should (consp seen))
|
||||
(should (eq (car seen) 'error)))
|
||||
(let (called)
|
||||
(should-error
|
||||
(handler-bind-1
|
||||
(lambda () (error "boom"))
|
||||
'error
|
||||
(lambda (_err) (setq called t) nil)))
|
||||
(should called))
|
||||
(should (equal (handler-bind-1 (lambda () 'ok)
|
||||
'error
|
||||
(lambda (_err) 'bad))
|
||||
'ok))
|
||||
(should-error (handler-bind-1 (lambda () 'ok) 'error)))
|
||||
|
||||
(ert-deftest eval-tests--run-hook-wrapped ()
|
||||
(let* ((hook (make-symbol "eval-tests--hook"))
|
||||
(calls nil)
|
||||
(wrapper (lambda (fun &rest args)
|
||||
(apply fun args))))
|
||||
(set hook (list (lambda (x) (push (list 'first x) calls) nil)
|
||||
(lambda (x) (push (list 'second x) calls) 'stop)
|
||||
(lambda (x) (push (list 'third x) calls) t)))
|
||||
(should (eq (run-hook-wrapped hook wrapper 42) 'stop))
|
||||
(should (equal (nreverse calls) '((first 42) (second 42))))))
|
||||
|
||||
(ert-deftest eval-tests--debugger-trap ()
|
||||
(should-not (debugger-trap)))
|
||||
|
||||
(defun eval-tests--backtrace-frame-helper (a b)
|
||||
(ignore a b)
|
||||
(backtrace-frame--internal
|
||||
(lambda (evald func args flags)
|
||||
(list evald func args flags))
|
||||
0 'eval-tests--backtrace-frame-helper))
|
||||
|
||||
(ert-deftest eval-tests--backtrace-frame--internal ()
|
||||
(let ((result (eval-tests--backtrace-frame-helper 1 2)))
|
||||
(should (eq (car result) t))
|
||||
(should (eq (nth 1 result) 'eval-tests--backtrace-frame-helper))
|
||||
(should (equal (nth 2 result) '(1 2)))
|
||||
(should (null (nth 3 result)))))
|
||||
|
||||
(defun eval-tests--backtrace-debug-helper ()
|
||||
(backtrace-debug 0 t 'eval-tests--backtrace-debug-helper)
|
||||
(unwind-protect
|
||||
(backtrace-frame--internal
|
||||
(lambda (_evald _func _args flags) flags)
|
||||
0 'eval-tests--backtrace-debug-helper)
|
||||
(backtrace-debug 0 nil 'eval-tests--backtrace-debug-helper)))
|
||||
|
||||
(ert-deftest eval-tests--backtrace-debug ()
|
||||
(let ((flags (eval-tests--backtrace-debug-helper)))
|
||||
(should (eq (plist-get flags :debug-on-exit) t))))
|
||||
|
||||
(ert-deftest eval-tests--backtrace-frames-from-thread ()
|
||||
(skip-unless (fboundp 'current-thread))
|
||||
(let* ((frames (backtrace--frames-from-thread (current-thread)))
|
||||
(found nil))
|
||||
(dolist (frame frames)
|
||||
(when (and (consp frame)
|
||||
(memq (car frame) '(t nil))
|
||||
(functionp (cadr frame)))
|
||||
(setq found t)))
|
||||
(should (listp frames))
|
||||
(should found)))
|
||||
|
||||
(defvar eval-tests--backtrace-eval-dyn)
|
||||
(defun eval-tests--backtrace-eval-helper ()
|
||||
(backtrace-eval 'eval-tests--backtrace-eval-dyn 1 'backtrace-eval))
|
||||
|
||||
(ert-deftest eval-tests--backtrace-eval ()
|
||||
(let ((eval-tests--backtrace-eval-dyn 42))
|
||||
;; Ensure the binding is established before the target frame.
|
||||
;; backtrace-eval temporarily unrewinds the specpdl to the frame it
|
||||
;; evaluates in, which would otherwise undo this binding.
|
||||
(should (= (eval-tests--backtrace-eval-helper) 42))))
|
||||
|
||||
(defvar eval-tests--backtrace-locals-dyn)
|
||||
(defun eval-tests--backtrace-locals-helper ()
|
||||
(let ((eval-tests--backtrace-locals-dyn 7))
|
||||
(backtrace--locals 1 'backtrace--locals)))
|
||||
|
||||
(ert-deftest eval-tests--backtrace-locals ()
|
||||
(let* ((locals (eval-tests--backtrace-locals-helper))
|
||||
(entry (assq 'eval-tests--backtrace-locals-dyn locals)))
|
||||
(should entry)
|
||||
(should (eq (cdr entry) 7))))
|
||||
|
||||
;;; eval-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -277,69 +277,5 @@ Also check that an encoding error can appear in a symlink."
|
|||
;; We should have prompted about the supersession threat.
|
||||
(should asked))))
|
||||
|
||||
(defvar fileio-tests--internal-counter 0)
|
||||
|
||||
(ert-deftest fileio-tests--directory-name-p ()
|
||||
(should (directory-name-p "/"))
|
||||
(should (directory-name-p "foo/"))
|
||||
(should-not (directory-name-p "foo")))
|
||||
|
||||
(ert-deftest fileio-tests--make-temp-file-internal ()
|
||||
(ert-with-temp-directory dir
|
||||
(let* ((prefix (expand-file-name "fileio-test" dir))
|
||||
(file (make-temp-file-internal prefix nil ".tmp" "hello")))
|
||||
(should (file-exists-p file))
|
||||
(should (equal (with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(buffer-string))
|
||||
"hello"))
|
||||
(delete-file file))
|
||||
(let* ((prefix (expand-file-name "fileio-test" dir))
|
||||
(name (make-temp-file-internal prefix 0 "" nil)))
|
||||
(should (stringp name))
|
||||
(should-not (file-exists-p name)))
|
||||
(let* ((prefix (expand-file-name "fileio-dir" dir))
|
||||
(name (make-temp-file-internal prefix t "" nil)))
|
||||
(should (file-directory-p name))
|
||||
(delete-directory name))))
|
||||
|
||||
(ert-deftest fileio-tests--make-delete-directory-internal ()
|
||||
(ert-with-temp-directory dir
|
||||
(let ((subdir (expand-file-name "subdir" dir)))
|
||||
(make-directory-internal subdir)
|
||||
(should (file-directory-p subdir))
|
||||
(delete-directory-internal subdir)
|
||||
(should-not (file-exists-p subdir)))))
|
||||
|
||||
(ert-deftest fileio-tests--delete-file-internal ()
|
||||
(ert-with-temp-file file
|
||||
(write-region "data" nil file nil 'silent)
|
||||
(should (file-exists-p file))
|
||||
(delete-file-internal file)
|
||||
(should-not (file-exists-p file))))
|
||||
|
||||
(ert-deftest fileio-tests--unix-sync ()
|
||||
(skip-unless (fboundp 'unix-sync))
|
||||
(should-not (unix-sync)))
|
||||
|
||||
(ert-deftest fileio-tests--auto-save-flags ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(should-not (recent-auto-save-p))
|
||||
(set-buffer-auto-saved)
|
||||
(should (recent-auto-save-p))
|
||||
(clear-buffer-auto-save-failure)
|
||||
(should (recent-auto-save-p))))
|
||||
|
||||
(ert-deftest fileio-tests--next-read-file-uses-dialog-p ()
|
||||
(skip-unless (and (boundp 'use-dialog-box) (boundp 'use-file-dialog)))
|
||||
(let ((use-dialog-box nil)
|
||||
(use-file-dialog nil))
|
||||
(should-not (next-read-file-uses-dialog-p))))
|
||||
|
||||
(ert-deftest fileio-tests--set-binary-mode ()
|
||||
(should (memq (set-binary-mode 'stdout t) '(nil t)))
|
||||
(should-error (set-binary-mode 'not-a-stream t)))
|
||||
|
||||
|
||||
;;; fileio-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -21,14 +21,6 @@
|
|||
|
||||
(require 'ert)
|
||||
|
||||
(defun floatfns-tests--approx= (a b &optional tol)
|
||||
"Return non-nil if A and B are approximately equal.
|
||||
This avoids spurious failures due to platform-specific libm behavior."
|
||||
(let* ((tol (or tol 1e-12))
|
||||
(diff (abs (- a b)))
|
||||
(scale (max 1.0 (abs a) (abs b))))
|
||||
(< diff (* tol scale))))
|
||||
|
||||
(ert-deftest floatfns-tests-cos ()
|
||||
(should (= (cos 0) 1.0))
|
||||
(should (= (cos float-pi) -1.0)))
|
||||
|
|
@ -39,22 +31,6 @@ This avoids spurious failures due to platform-specific libm behavior."
|
|||
(ert-deftest floatfns-tests-tan ()
|
||||
(should (= (tan 0) 0.0)))
|
||||
|
||||
(ert-deftest floatfns-tests-asin-acos-atan ()
|
||||
(let ((eps 1e-12))
|
||||
(should (< (abs (- (asin 0.0) 0.0)) eps))
|
||||
(should (< (abs (- (asin 1.0) (/ float-pi 2))) eps))
|
||||
(should (< (abs (- (acos 1.0) 0.0)) eps))
|
||||
(should (< (abs (- (acos 0.0) (/ float-pi 2))) eps))
|
||||
(should (< (abs (- (atan 0.0) 0.0)) eps))
|
||||
(should (< (abs (- (atan 1.0) (/ float-pi 4))) eps))
|
||||
(should (< (abs (- (atan 0.0 -1.0) float-pi)) eps))))
|
||||
|
||||
(ert-deftest floatfns-tests-copysign ()
|
||||
(should (= (copysign 1.0 2.0) 1.0))
|
||||
(should (= (copysign 1.0 -2.0) -1.0))
|
||||
(should (= (copysign -1.0 2.0) 1.0))
|
||||
(should (= (copysign -1.0 -2.0) -1.0)))
|
||||
|
||||
(ert-deftest floatfns-tests-isnan ()
|
||||
(should (isnan 0.0e+NaN))
|
||||
(should (isnan -0.0e+NaN))
|
||||
|
|
@ -67,8 +43,7 @@ This avoids spurious failures due to platform-specific libm behavior."
|
|||
(should (= (expt 2 8) 256)))
|
||||
|
||||
(ert-deftest floatfns-tests-log ()
|
||||
(should (= (log 1000 10) 3.0))
|
||||
(should (floatfns-tests--approx= (log 8 2) 3.0)))
|
||||
(should (= (log 1000 10) 3.0)))
|
||||
|
||||
(ert-deftest floatfns-tests-sqrt ()
|
||||
(should (= (sqrt 25) 5)))
|
||||
|
|
@ -77,23 +52,6 @@ This avoids spurious failures due to platform-specific libm behavior."
|
|||
(should (= (abs 10) 10))
|
||||
(should (= (abs -10) 10)))
|
||||
|
||||
(ert-deftest floatfns-tests-float ()
|
||||
(should (= (float 0) 0.0))
|
||||
(should (= (float 1) 1.0))
|
||||
(should (= (float -1) -1.0))
|
||||
(should (= (float 1.5) 1.5)))
|
||||
|
||||
(ert-deftest floatfns-tests-frexp-ldexp ()
|
||||
(dolist (x '(0.0 1.0 -1.0 2.0 3.5 0.5 -0.5 1024.0))
|
||||
(pcase-let ((`(,sig . ,exp) (frexp x)))
|
||||
(should (floatp sig))
|
||||
(should (integerp exp))
|
||||
(if (zerop x)
|
||||
(should (= sig 0.0))
|
||||
(should (<= 0.5 (abs sig)))
|
||||
(should (< (abs sig) 1.0)))
|
||||
(should (floatfns-tests--approx= (ldexp sig exp) (float x) 1e-12)))))
|
||||
|
||||
(ert-deftest floatfns-tests-logb ()
|
||||
(should (= (logb 10000) 13)))
|
||||
|
||||
|
|
|
|||
|
|
@ -64,133 +64,6 @@
|
|||
(ert-deftest fns-tests-string-bytes ()
|
||||
(should (= (string-bytes "abc") 3)))
|
||||
|
||||
(ert-deftest fns-tests-string-make-multibyte ()
|
||||
(let* ((ascii (string-make-unibyte "abc"))
|
||||
(ascii-mb (string-make-multibyte ascii)))
|
||||
(should (string= ascii-mb "abc"))
|
||||
(should-not (multibyte-string-p ascii-mb)))
|
||||
(let* ((u (string-make-unibyte "é"))
|
||||
(m (string-make-multibyte u)))
|
||||
(should (multibyte-string-p m))
|
||||
(should (string= (string-as-unibyte m) u))))
|
||||
|
||||
(ert-deftest fns-tests-string-make-unibyte ()
|
||||
(let ((s (propertize "é" 'foo 'bar)))
|
||||
(let ((u (string-make-unibyte s)))
|
||||
(should-not (multibyte-string-p u))
|
||||
(should (equal (aref u 0) ?\xE9))
|
||||
(should-not (text-properties-at 0 u)))))
|
||||
|
||||
(ert-deftest fns-tests-string-as-multibyte ()
|
||||
(let* ((u (string-make-unibyte "abc"))
|
||||
(m (string-as-multibyte u)))
|
||||
(should (string= m "abc"))
|
||||
(should (multibyte-string-p m))
|
||||
(should-not (text-properties-at 0 m)))
|
||||
(let ((m "abc"))
|
||||
(should (string= (string-as-multibyte m) m))))
|
||||
|
||||
(ert-deftest fns-tests-fillarray ()
|
||||
(let ((v (vector 1 2 3)))
|
||||
(fillarray v 'x)
|
||||
(should (equal v [x x x])))
|
||||
(let ((s (string-make-unibyte "aaa")))
|
||||
(fillarray s ?b)
|
||||
(should (string= s "bbb"))
|
||||
(should-not (multibyte-string-p s)))
|
||||
(let ((bv (make-bool-vector 4 nil)))
|
||||
(fillarray bv t)
|
||||
(should (equal bv (make-bool-vector 4 t))))
|
||||
(let ((ct (make-char-table 'fns-tests)))
|
||||
(fillarray ct 'z)
|
||||
(should (eq (char-table-range ct ?a) 'z))))
|
||||
|
||||
(ert-deftest fns-tests-clear-string ()
|
||||
(let ((s (propertize "é" 'foo 'bar)))
|
||||
(clear-string s)
|
||||
(should-not (multibyte-string-p s))
|
||||
(should (equal s (make-string 2 0)))
|
||||
(should-not (text-properties-at 0 s))))
|
||||
|
||||
(ert-deftest fns-tests-load-average ()
|
||||
(let ((res (condition-case err
|
||||
(list :ok (load-average) (load-average t))
|
||||
(error (list :error err)))))
|
||||
(pcase res
|
||||
(`(:ok ,ints ,floats)
|
||||
(should (listp ints))
|
||||
(should (<= 1 (length ints) 3))
|
||||
(dolist (v ints)
|
||||
(should (integerp v))
|
||||
(should (>= v 0)))
|
||||
(should (listp floats))
|
||||
(should (<= 1 (length floats) 3))
|
||||
(dolist (v floats)
|
||||
(should (floatp v))
|
||||
(should (>= v 0.0))))
|
||||
(`(:error ,err)
|
||||
(should (string-match-p "load-average not implemented"
|
||||
(error-message-string err)))))))
|
||||
|
||||
(ert-deftest fns-tests-locale-info ()
|
||||
(let ((codeset (locale-info 'codeset)))
|
||||
(should (or (null codeset) (stringp codeset))))
|
||||
(let ((days (locale-info 'days)))
|
||||
(should (or (null days) (and (vectorp days) (= (length days) 7)))))
|
||||
(let ((months (locale-info 'months)))
|
||||
(should (or (null months) (and (vectorp months) (= (length months) 12)))))
|
||||
(let ((paper (locale-info 'paper)))
|
||||
(should (or (null paper)
|
||||
(and (consp paper)
|
||||
(= (length paper) 2)
|
||||
(integerp (car paper))
|
||||
(integerp (cadr paper))))))
|
||||
(should-not (locale-info 'fns-tests-no-such-item)))
|
||||
|
||||
(ert-deftest fns-tests-sxhash-eql ()
|
||||
(let* ((a (1+ most-positive-fixnum))
|
||||
(b (+ most-positive-fixnum 1)))
|
||||
(should (eql a b))
|
||||
(should (integerp (sxhash-eql a)))
|
||||
(should (= (sxhash-eql a) (sxhash-eql b)))))
|
||||
|
||||
(ert-deftest fns-tests-sxhash-equal-including-properties ()
|
||||
(let ((a (propertize "foo" 'face 'bold))
|
||||
(b (propertize "foo" 'face 'bold)))
|
||||
(should (equal-including-properties a b))
|
||||
(should (integerp (sxhash-equal-including-properties a)))
|
||||
(should (= (sxhash-equal-including-properties a)
|
||||
(sxhash-equal-including-properties b)))))
|
||||
|
||||
(ert-deftest fns-tests-hash-table-metadata ()
|
||||
(let ((h (make-hash-table :test 'equal)))
|
||||
(puthash "a" 1 h)
|
||||
(puthash "b" 2 h)
|
||||
(should (= (hash-table-rehash-size h) 1.5))
|
||||
(should (= (hash-table-rehash-threshold h) 0.8125))
|
||||
(should (integerp (hash-table-size h)))
|
||||
(should (>= (hash-table-size h) (hash-table-count h)))
|
||||
(should (integerp (internal--hash-table-index-size h)))
|
||||
(let ((hist (internal--hash-table-histogram h)))
|
||||
(should (or (null hist)
|
||||
(and (consp hist)
|
||||
(consp (car hist))
|
||||
(integerp (caar hist))
|
||||
(integerp (cdar hist))))))
|
||||
(let ((buckets (internal--hash-table-buckets h)))
|
||||
(should (listp buckets))
|
||||
(let ((keys (cl-loop for bucket in buckets
|
||||
append (mapcar #'car bucket))))
|
||||
(should (member "a" keys))
|
||||
(should (member "b" keys))))))
|
||||
|
||||
(ert-deftest fns-tests-secure-hash-algorithms ()
|
||||
(let ((algs (secure-hash-algorithms)))
|
||||
(should (listp algs))
|
||||
(should (memq 'md5 algs))
|
||||
(should (memq 'sha1 algs))
|
||||
(should (memq 'sha256 algs))))
|
||||
|
||||
;; Test that equality predicates work correctly on NaNs when combined
|
||||
;; with hash tables based on those predicates. This was not the case
|
||||
;; for eql in Emacs 26.
|
||||
|
|
@ -662,58 +535,6 @@
|
|||
(should (equal (fns-tests--with-region base64-encode-region "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l+"))
|
||||
(should (equal (fns-tests--with-region base64-encode-region "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/")))
|
||||
|
||||
(defun fns-tests--base64-decode-region (input &optional base64url ignore-invalid)
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(insert input)
|
||||
(let ((len (base64-decode-region (point-min) (point-max)
|
||||
base64url ignore-invalid)))
|
||||
(list len (buffer-string)))))
|
||||
|
||||
(defun fns-tests--as-unibyte (string)
|
||||
(encode-coding-string string 'binary))
|
||||
|
||||
(ert-deftest fns-tests-base64-decode-region ()
|
||||
;; standard variant RFC2045
|
||||
(should (equal (fns-tests--base64-decode-region "") '(0 "")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zg==") '(1 "f")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zm8=") '(2 "fo")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zm9v") '(3 "foo")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zm9vYg==") '(4 "foob")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zm9vYmE=") '(5 "fooba")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zm9vYmFy") '(6 "foobar")))
|
||||
(let* ((res (fns-tests--base64-decode-region "FPucA9l+"))
|
||||
(len (nth 0 res))
|
||||
(out (nth 1 res)))
|
||||
(should (= len (string-bytes out)))
|
||||
(should (equal (fns-tests--as-unibyte out)
|
||||
(fns-tests--as-unibyte "\x14\xfb\x9c\x03\xd9\x7e"))))
|
||||
(let* ((res (fns-tests--base64-decode-region "FPucA9l/"))
|
||||
(len (nth 0 res))
|
||||
(out (nth 1 res)))
|
||||
(should (= len (string-bytes out)))
|
||||
(should (equal (fns-tests--as-unibyte out)
|
||||
(fns-tests--as-unibyte "\x14\xfb\x9c\x03\xd9\x7f"))))
|
||||
|
||||
;; url variant
|
||||
(let* ((res (fns-tests--base64-decode-region "FPucA9l-" t))
|
||||
(len (nth 0 res))
|
||||
(out (nth 1 res)))
|
||||
(should (= len (string-bytes out)))
|
||||
(should (equal (fns-tests--as-unibyte out)
|
||||
(fns-tests--as-unibyte "\x14\xfb\x9c\x03\xd9\x7e"))))
|
||||
(let* ((res (fns-tests--base64-decode-region "FPucA9l_" t))
|
||||
(len (nth 0 res))
|
||||
(out (nth 1 res)))
|
||||
(should (= len (string-bytes out)))
|
||||
(should (equal (fns-tests--as-unibyte out)
|
||||
(fns-tests--as-unibyte "\x14\xfb\x9c\x03\xd9\x7f"))))
|
||||
|
||||
;; ignore invalid characters
|
||||
(should (equal (fns-tests--base64-decode-region "Zg==@" nil t) '(1 "f")))
|
||||
(should (equal (fns-tests--base64-decode-region "Zg==@" t t) '(1 "f")))
|
||||
(should-error (fns-tests--base64-decode-region "Zg=")))
|
||||
|
||||
(ert-deftest fns-tests-base64-encode-string ()
|
||||
;; standard variant RFC2045
|
||||
(should (equal (base64-encode-string "") ""))
|
||||
|
|
|
|||
|
|
@ -37,22 +37,6 @@
|
|||
(ert-deftest keymap-make-sparse-keymap ()
|
||||
(keymap-tests--make-keymap-test #'make-sparse-keymap))
|
||||
|
||||
(ert-deftest keymap-accessible-keymaps ()
|
||||
(let* ((map (make-sparse-keymap))
|
||||
(sub (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-x") sub)
|
||||
(define-key sub (kbd "C-f") #'find-file)
|
||||
(define-key map (kbd "C-c") #'ignore)
|
||||
(let ((maps (accessible-keymaps map)))
|
||||
(should (equal (caar maps) []))
|
||||
(should (eq (cdar maps) map))
|
||||
(should (assoc [?\C-x] maps))
|
||||
(should (eq (cdr (assoc [?\C-x] maps)) sub))
|
||||
(should-not (assoc [?\C-c] maps)))
|
||||
(let ((pref (accessible-keymaps map (kbd "C-x"))))
|
||||
(should (equal (caar pref) [?\C-x]))
|
||||
(should (eq (cdar pref) sub)))))
|
||||
|
||||
(ert-deftest keymap-keymapp ()
|
||||
(should (keymapp (make-keymap)))
|
||||
(should (keymapp (make-sparse-keymap)))
|
||||
|
|
|
|||
|
|
@ -504,50 +504,4 @@ literals (Bug#20852)."
|
|||
(should (equal (oa-syms oa) (list s2))))
|
||||
))
|
||||
|
||||
(ert-deftest lread-tests--get-load-suffixes ()
|
||||
(let ((load-suffixes '(".el" ".elc"))
|
||||
(load-file-rep-suffixes '("" ".gz")))
|
||||
(should (equal (get-load-suffixes)
|
||||
'(".el" ".el.gz" ".elc" ".elc.gz")))))
|
||||
|
||||
(ert-deftest lread-tests--locate-file-internal ()
|
||||
(let* ((dir (make-temp-file "lread-tests" t))
|
||||
(file (expand-file-name "foo.el" dir))
|
||||
(subdir (expand-file-name "bar" dir)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-temp-file file)
|
||||
(make-directory subdir)
|
||||
(should (equal (locate-file-internal "foo" (list dir) '(".el") nil)
|
||||
file))
|
||||
(should-not (locate-file-internal "bar" (list dir) nil nil))
|
||||
(should (equal (locate-file-internal
|
||||
"bar" (list dir) nil
|
||||
(lambda (path)
|
||||
(if (file-directory-p path) 'dir-ok
|
||||
(file-readable-p path))))
|
||||
subdir)))
|
||||
(ignore-errors (delete-file file))
|
||||
(ignore-errors (delete-directory subdir))
|
||||
(ignore-errors (delete-directory dir)))))
|
||||
|
||||
(ert-deftest lread-tests--internal-obarray-buckets ()
|
||||
(let* ((oa (obarray-make 7))
|
||||
(s1 (intern "alpha" oa))
|
||||
(s2 (intern "beta" oa))
|
||||
(s3 (intern "gamma" oa))
|
||||
(buckets (internal--obarray-buckets oa))
|
||||
(flat nil)
|
||||
(expected (list s1 s2 s3)))
|
||||
(dolist (bucket buckets)
|
||||
(dolist (sym bucket)
|
||||
(push sym flat)))
|
||||
(should (= (length flat) (length (delete-dups (copy-sequence flat)))))
|
||||
(setq flat (sort flat (lambda (a b)
|
||||
(string< (symbol-name a) (symbol-name b)))))
|
||||
(setq expected (sort (copy-sequence expected)
|
||||
(lambda (a b)
|
||||
(string< (symbol-name a) (symbol-name b)))))
|
||||
(should (equal flat expected))))
|
||||
|
||||
;;; lread-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -57,119 +57,4 @@
|
|||
(set-marker marker-2 marker-1)
|
||||
(should (goto-char marker-2))))
|
||||
|
||||
(ert-deftest marker-tests--insertion-type ()
|
||||
(with-temp-buffer
|
||||
(insert "ab")
|
||||
(goto-char 2)
|
||||
(let ((m1 (point-marker))
|
||||
(m2 (copy-marker (point) t)))
|
||||
(should-not (marker-insertion-type m1))
|
||||
(should (marker-insertion-type m2))
|
||||
(insert "X")
|
||||
(should (= (marker-position m1) 2))
|
||||
(should (= (marker-position m2) 3)))))
|
||||
|
||||
(ert-deftest marker-tests--set-marker-insertion-type ()
|
||||
(with-temp-buffer
|
||||
(insert "ab")
|
||||
(goto-char 2)
|
||||
(let ((m (point-marker)))
|
||||
(should-not (marker-insertion-type m))
|
||||
(should (eq (set-marker-insertion-type m t) t))
|
||||
(should (marker-insertion-type m))
|
||||
(insert "X")
|
||||
(should (= (marker-position m) 3))
|
||||
(goto-char (marker-position m))
|
||||
(should (eq (set-marker-insertion-type m nil) nil))
|
||||
(should-not (marker-insertion-type m))
|
||||
(insert "Y")
|
||||
(should (= (marker-position m) 3)))))
|
||||
|
||||
(ert-deftest marker-tests--copy-marker-nil ()
|
||||
(let ((m (copy-marker nil)))
|
||||
(should-not (marker-buffer m))
|
||||
(should-not (marker-position m))))
|
||||
|
||||
(ert-deftest marker-tests--marker-buffer ()
|
||||
(with-temp-buffer
|
||||
(let ((m (make-marker)))
|
||||
(should-not (marker-buffer m))
|
||||
(set-marker m (point) (current-buffer))
|
||||
(should (eq (marker-buffer m) (current-buffer)))
|
||||
(set-marker m nil)
|
||||
(should-not (marker-buffer m)))))
|
||||
|
||||
(ert-deftest marker-tests--last-position-after-kill ()
|
||||
(let (marker pos)
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(setq marker (point-marker))
|
||||
(setq pos (point))
|
||||
(should (= (marker-position marker) pos)))
|
||||
(should-not (marker-buffer marker))
|
||||
(should-not (marker-position marker))
|
||||
(should (= (marker-last-position marker) pos))))
|
||||
|
||||
(ert-deftest marker-tests--copy-marker ()
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(goto-char 2)
|
||||
(let ((m1 (point-marker))
|
||||
(m2 (copy-marker (point) t))
|
||||
(m3 (copy-marker (point) nil))
|
||||
(m4 (copy-marker 1)))
|
||||
(should (equal m1 m2))
|
||||
(should (eq (marker-buffer m1) (marker-buffer m2)))
|
||||
(should (marker-insertion-type m2))
|
||||
(should-not (marker-insertion-type m3))
|
||||
(should (eq (marker-buffer m4) (current-buffer)))
|
||||
(should (= (marker-position m4) 1)))))
|
||||
|
||||
(ert-deftest marker-tests--set-marker-and-move-marker ()
|
||||
(let ((m (make-marker))
|
||||
(m2 (make-marker)))
|
||||
(with-temp-buffer
|
||||
(insert "abc")
|
||||
(should (eq (set-marker m 2 (current-buffer)) m))
|
||||
(should (eq (marker-buffer m) (current-buffer)))
|
||||
(should (= (marker-position m) 2))
|
||||
(should (eq (move-marker m 1 (current-buffer)) m))
|
||||
(should (= (marker-position m) 1))
|
||||
(set-marker m2 nil)
|
||||
(set-marker m m2)
|
||||
(should-not (marker-buffer m))
|
||||
(should-not (marker-position m))
|
||||
(set-marker m 1 (current-buffer))
|
||||
(set-marker m nil)
|
||||
(should-not (marker-buffer m))
|
||||
(should-not (marker-position m)))))
|
||||
|
||||
(ert-deftest marker-tests--point-min-max-marker-narrowing ()
|
||||
(with-temp-buffer
|
||||
(insert "abcd")
|
||||
(narrow-to-region 2 3)
|
||||
(let ((minm (point-min-marker))
|
||||
(maxm (point-max-marker)))
|
||||
(should (= (marker-position minm) 2))
|
||||
(should (= (marker-position maxm) 3))
|
||||
(should (eq (marker-buffer minm) (current-buffer))))))
|
||||
|
||||
(ert-deftest marker-tests--move-marker-between-buffers ()
|
||||
(let ((buf-1 (generate-new-buffer " *marker-tests-1*"))
|
||||
(buf-2 (generate-new-buffer " *marker-tests-2*")))
|
||||
(unwind-protect
|
||||
(let ((m (make-marker)))
|
||||
(with-current-buffer buf-1
|
||||
(insert "abc")
|
||||
(set-marker m 2 (current-buffer)))
|
||||
(should (eq (marker-buffer m) buf-1))
|
||||
(should (= (marker-position m) 2))
|
||||
(with-current-buffer buf-2
|
||||
(insert "xyz")
|
||||
(set-marker m 1 (current-buffer)))
|
||||
(should (eq (marker-buffer m) buf-2))
|
||||
(should (= (marker-position m) 1)))
|
||||
(kill-buffer buf-1)
|
||||
(kill-buffer buf-2))))
|
||||
|
||||
;;; marker-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -431,9 +431,5 @@
|
|||
(error nil))
|
||||
'inhibit))))
|
||||
|
||||
(ert-deftest minibuf-tests-active-minibuffer-window ()
|
||||
(should-not (active-minibuffer-window))
|
||||
(should (windowp (minibuffer-window))))
|
||||
|
||||
|
||||
;;; minibuf-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -570,45 +570,5 @@ otherwise, use a different charset."
|
|||
(should (equal (prin1-to-string (make-symbol "th\303\251"))
|
||||
(string-to-multibyte "th\303\251"))))
|
||||
|
||||
(ert-deftest print-tests--write-char ()
|
||||
(should (equal (with-output-to-string (write-char ?A)) "A"))
|
||||
(let (out)
|
||||
(should (= (write-char ?Z (lambda (c)
|
||||
(setq out (concat out (string c)))))
|
||||
?Z))
|
||||
(should (equal out "Z"))))
|
||||
|
||||
(ert-deftest print-tests--redirect-debugging-output ()
|
||||
(let ((file (make-temp-file "print-tests-debug")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(redirect-debugging-output file nil)
|
||||
(external-debugging-output ?A)
|
||||
(external-debugging-output ?B)
|
||||
(redirect-debugging-output nil)
|
||||
(should (equal (with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(buffer-string))
|
||||
"AB")))
|
||||
(ignore-errors (redirect-debugging-output nil))
|
||||
(ignore-errors (delete-file file)))))
|
||||
|
||||
(ert-deftest print-tests--preprocess ()
|
||||
(let* ((x (list 1 2))
|
||||
(obj (list x x))
|
||||
(print-circle t)
|
||||
(print-number-table nil))
|
||||
(print--preprocess obj)
|
||||
(should (hash-table-p print-number-table))
|
||||
(should (> (hash-table-count print-number-table) 0))
|
||||
(should (gethash x print-number-table)))
|
||||
(let* ((x (list 1 2))
|
||||
(obj (list x x))
|
||||
(print-circle nil)
|
||||
(print-number-table (make-hash-table :test 'eq)))
|
||||
(puthash 'sentinel 'value print-number-table)
|
||||
(print--preprocess obj)
|
||||
(should (eq (gethash 'sentinel print-number-table) 'value))))
|
||||
|
||||
(provide 'print-tests)
|
||||
;;; print-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue