From fdab8a91858f0581209b6058dabdd706b608edb5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 7 May 2026 15:24:10 +0100 Subject: [PATCH] ; Revert Eric's commits from February. These will be resubmitted as patches for review. Revert "Repair another test bollixed by aggressive optimization." This reverts commit 47735e0243ba15a485e1a6f25be53f6e42dafa24. Revert "Repair ab ecal test by making a variable kexical," This reverts commit ca42055b0ca3bba1b635e314f084239f5a205534. Revert "Complete the test set for floatfns,c." This reverts commit 1b0c8d6b95f0704936e4449270a815abb8865c3d. Revert "Tesrts for the portable primitives in fileio.c." This reverts commit a339c6827c0bb1e80de1cfb9c51b4c4b764046bc. Revert "Tests for primitives in coding.c and charset.c." This reverts commit 5749b2e4f4d11dd646892e70f520700e4f0f16f5. Revert "Tests for primitives from the character.c module." This reverts commit b09f8df206aae1e4b70d8961e6693d574aea6a30. Revert "Tests for the lreaf.c amd print.c primitives." This reverts commit d7a3d442b4cdfd88447eec49339dfa5d69342de9. Revert "Tests for remaining functions iun eval.c." This reverts commit cd038e5617ff940ead880fbc9c1df95e61453246. Revert "Completing test coverage for dataa.c orimitives." This reverts commit a6e19d6179ad608688c6edcc2b1f7368c05dff69. Revert "More correctness tesrs for orinitives from fns.c." This reverts commit 40ff4512ad12fd29a5bea887fe77c3bddfa4caec. Revert "More tests for edit functions, buffers, and markers." This reverts commit 67e8f875627e38450a6c713e810dcea2106c6d9c. Revert "Added more buffer/marker/editing test coverage." This reverts commit 3dda4b85e8a66a0c5592197dcc2895d65c04bc51. Revert "Category/charset/coding + char-table tests." This reverts commit 7a93a7b3345f7ae4e8f487b562b19a4b5fed8496. Revert "More test coverage improvements." This reverts commit fc7339c46dc87d5d7051f976206bb5c4d9efdfb8. Revert "More test coverage improvements." This reverts commit 95329bf445841a763bafa4ea5e853fc1c6f6bf0a. Revert "More test coverage improvements for ERT." This reverts commit e42c579a544d3d254e55db2f6b70e55205987d36. Revert "Crrections to tedt coverrage extensuion after bootstrap build." This reverts commit 90af3295c7fa705381bf680ec8559503ea875683. Revert "Improve test coverage of builtin predicates." This reverts commit 6eb170b007a4ad63fe5666033df191f52d480739. Revert "Tests for 2 marker primitives previously not covered." This reverts commit 6d7f0acf9cc15b388f90363d012aaba3d95be6c8. Revert "Tests for 7 editor primitives previously not covered." This reverts commit bb403e70aec25677393d4f37d544487a9aebab9e. --- test/src/buffer-tests.el | 72 -------- test/src/category-tests.el | 71 -------- test/src/character-tests.el | 15 -- test/src/charset-tests.el | 121 ------------- test/src/chartab-tests.el | 9 - test/src/coding-tests.el | 149 ---------------- test/src/data-tests.el | 199 --------------------- test/src/editfns-tests.el | 308 --------------------------------- test/src/emacs-module-tests.el | 7 - test/src/eval-tests.el | 172 ------------------ test/src/fileio-tests.el | 64 ------- test/src/floatfns-tests.el | 44 +---- test/src/fns-tests.el | 179 ------------------- test/src/keymap-tests.el | 16 -- test/src/lread-tests.el | 46 ----- test/src/marker-tests.el | 115 ------------ test/src/minibuf-tests.el | 4 - test/src/print-tests.el | 40 ----- 18 files changed, 1 insertion(+), 1630 deletions(-) delete mode 100644 test/src/category-tests.el diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 42c67459db5..3fae18011fb 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -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") diff --git a/test/src/category-tests.el b/test/src/category-tests.el deleted file mode 100644 index e66d7d40fe6..00000000000 --- a/test/src/category-tests.el +++ /dev/null @@ -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 . - -;;; 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 diff --git a/test/src/character-tests.el b/test/src/character-tests.el index ab94ae663dd..9c3dac24637 100644 --- a/test/src/character-tests.el +++ b/test/src/character-tests.el @@ -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 diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el index ff7af4fc5c2..1b26dc2a2ae 100644 --- a/test/src/charset-tests.el +++ b/test/src/charset-tests.el @@ -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" diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el index 24b0f6d12d4..0f2e65b89a0 100644 --- a/test/src/chartab-tests.el +++ b/test/src/chartab-tests.el @@ -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 diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el index c318b6f4e50..dc1abec2d58 100644 --- a/test/src/coding-tests.el +++ b/test/src/coding-tests.el @@ -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 diff --git a/test/src/data-tests.el b/test/src/data-tests.el index c64a8a98725..2fc971d0214 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -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))) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index ffede950bcf..9bdd5cf5db6 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -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 diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 5d3abb0d76b..e678fba3873 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -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 diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 1cb6dcea43e..1e7c33069a7 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -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 diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index b130f37620a..2c27ef35701 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -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 diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 1c0df17594c..49e76b809a3 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -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))) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d0cb11c2305..0288e3a460e 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -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 "") "")) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 004ec1cee04..c53ab7871c3 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -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))) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 50281471389..e621a9d58b9 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -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 diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el index 2a29b788f32..ddd8bc702e4 100644 --- a/test/src/marker-tests.el +++ b/test/src/marker-tests.el @@ -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 diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 36ca3604acf..5bfbe710b10 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -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 diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 033049afbdf..1485e063ab3 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -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