1 files changed, 249 insertions, 70 deletions
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 70dc9372fad..5fe896fbbd1 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -1,21 +1,21 @@
-;;; editfns-tests.el -- tests for editfns.c
+;;; editfns-tests.el --- tests for editfns.c  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2022 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
 
-;; This program is distributed in the hope that it will be useful,
+;; 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 this program.  If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Code:
 
@@ -23,16 +23,16 @@
 
 (ert-deftest format-properties ()
   ;; Bug #23730
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format (propertize "%d" 'face '(:background "red")) 1)
            #("1" 0 1 (face (:background "red")))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format (propertize "%2d" 'face '(:background "red")) 1)
            #(" 1" 0 2 (face (:background "red")))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format (propertize "%02d" 'face '(:background "red")) 1)
            #("01" 0 2 (face (:background "red")))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format (concat (propertize "%2d" 'x 'X)
                            (propertize "a" 'a 'A)
                            (propertize "b" 'b 'B))
@@ -40,27 +40,27 @@
            #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B))))
 
   ;; Bug #5306
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%.10s"
                    (concat "1234567890aaaa"
                            (propertize "12345678901234567890" 'xxx 25)))
            "1234567890"))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%.10s"
                    (concat "123456789"
                            (propertize "12345678901234567890" 'xxx 25)))
            #("1234567891" 9 10 (xxx 25))))
 
   ;; Bug #23859
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%4s" (propertize "hi" 'face 'bold))
            #("  hi" 2 4 (face bold))))
 
   ;; Bug #23897
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%s" (concat (propertize "01234" 'face 'bold) "56789"))
            #("0123456789" 0 5 (face bold))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%s" (concat (propertize "01" 'face 'bold)
                                 (propertize "23" 'face 'underline)
                                 "45"))
@@ -68,27 +68,69 @@
   ;; The last property range is extended to include padding on the
   ;; right, but the first range is not extended to the left to include
   ;; padding on the left!
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%12s" (concat (propertize "01234" 'face 'bold) "56789"))
            #("  0123456789" 2 7 (face bold))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789"))
            #("0123456789  " 0 5 (face bold))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%10s" (concat (propertize "01" 'face 'bold)
                                   (propertize "23" 'face 'underline)
                                   "45"))
            #("    012345" 4 6 (face bold) 6 8 (face underline))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%-10s" (concat (propertize "01" 'face 'bold)
                                    (propertize "23" 'face 'underline)
                                    "45"))
            #("012345    " 0 2 (face bold) 2 4 (face underline))))
-  (should (ert-equal-including-properties
+  (should (equal-including-properties
            (format "%-10s" (concat (propertize "01" 'face 'bold)
                                    (propertize "23" 'face 'underline)
                                    (propertize "45" 'face 'italic)))
-           #("012345    " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))))
+           #("012345    "
+             0 2 (face bold) 2 4 (face underline) 4 10 (face italic))))
+  ;; Bug #38191
+  (should (equal-including-properties
+           (format (propertize "‘foo’ %s bar" 'face 'bold) "xxx")
+           #("‘foo’ xxx bar" 0 13 (face bold))))
+  ;; Bug #32404
+  (should (equal-including-properties
+           (format (concat (propertize "%s" 'face 'bold)
+                           ""
+                           (propertize "%s" 'face 'error))
+                   "foo" "bar")
+           #("foobar" 0 3 (face bold) 3 6 (face error))))
+  (should (equal-including-properties
+           (format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar")
+           #("foobar" 3 6 (face error))))
+  (should (equal-including-properties
+           (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar")
+           #("foo bar" 4 7 (face error))))
+  ;; Bug #46317
+  (let ((s (propertize "X" 'prop "val")))
+    (should (equal-including-properties
+             (format (concat "%3s/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (equal-including-properties
+             (format (concat "%3S/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (equal-including-properties
+             (format (concat "%3d/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (equal-including-properties
+             (format (concat "%-3s/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))
+    (should (equal-including-properties
+             (format (concat "%-3S/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))
+    (should (equal-including-properties
+             (format (concat "%-3d/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))))
+
+(ert-deftest propertize/error-even-number-of-args ()
+  "Number of args for `propertize' must be odd."
+  (should-error (propertize "foo" 'bar) :type 'wrong-number-of-arguments))
 
 ;; Tests for bug#5131.
 (defun transpose-test-reverse-word (start end)
@@ -106,8 +148,8 @@
   "Validate character position to byte position translation."
   (let ((bytes '()))
     (dotimes (pos len)
-      (setq bytes (add-to-list 'bytes (position-bytes (1+ pos)) t)))
-    bytes))
+      (push (position-bytes (1+ pos)) bytes))
+    (nreverse bytes)))
 
 (ert-deftest transpose-ascii-regions-test ()
   (with-temp-buffer
@@ -136,54 +178,59 @@
 (ert-deftest format-c-float ()
   (should-error (format "%c" 0.5)))
 
-;;; Check format-time-string with various TZ settings.
-;;; Use only POSIX-compatible TZ values, since the tests should work
-;;; even if tzdb is not in use.
-(ert-deftest format-time-string-with-zone ()
-  ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs
-  ;; in MS-Windows (and presumably other) C libraries when formatting
-  ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
-  ;; test is for GNU Emacs, not for C runtimes.  Instead, look before
-  ;; you leap: "look" is the timestamp just before the first leap
-  ;; second on 1972-06-30 23:59:60 UTC, so it should format to the
-  ;; same string regardless of whether the underlying C library
-  ;; ignores leap seconds, while avoiding circa-1970 glitches.
-  ;;
-  ;; Similarly, stick to the limited set of time zones that are
-  ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
-  ;; in the abbreviation, and no DST.
-  (let ((look '(1202 22527 999999 999999))
-        (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
-    ;; UTC.
-    (should (string-equal
-             (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
-             "1972-06-30 23:59:59.999 +0000"))
-    ;; "UTC0".
-    (should (string-equal
-             (format-time-string format look "UTC0")
-             "1972-06-30 23:59:59.999 +0000 (UTC)"))
-    ;; Negative UTC offset, as a Lisp list.
-    (should (string-equal
-             (format-time-string format look '(-28800 "PST"))
-             "1972-06-30 15:59:59.999 -0800 (PST)"))
-    ;; Negative UTC offset, as a Lisp integer.
-    (should (string-equal
-             (format-time-string format look -28800)
-             ;; MS-Windows build replaces unrecognizable TZ values,
-             ;; such as "-08", with "ZZZ".
-             (if (eq system-type 'windows-nt)
-                 "1972-06-30 15:59:59.999 -0800 (ZZZ)"
-               "1972-06-30 15:59:59.999 -0800 (-08)")))
-    ;; Positive UTC offset that is not an hour multiple, as a string.
-    (should (string-equal
-             (format-time-string format look "IST-5:30")
-             "1972-07-01 05:29:59.999 +0530 (IST)"))))
-
-;;; This should not dump core.
-(ert-deftest format-time-string-with-outlandish-zone ()
-  (should (stringp
-           (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
-                               (concat (make-string 2048 ?X) "0")))))
+;;; Test for Bug#29609.
+(ert-deftest format-sharp-0-x ()
+  (should (string-equal (format "%#08x" #x10) "0x000010"))
+  (should (string-equal (format "%#05X" #x10) "0X010"))
+  (should (string-equal (format "%#04x" 0) "0000")))
+
+
+;;; Tests for Bug#30408.
+
+(ert-deftest format-%d-large-float ()
+  (should (string-equal (format "%d" 18446744073709551616.0)
+                        "18446744073709551616"))
+  (should (string-equal (format "%d" -18446744073709551616.0)
+                        "-18446744073709551616")))
+
+(ert-deftest format-%x-large-float ()
+  (should (string-equal (format "%x" 18446744073709551616.0)
+                        "10000000000000000")))
+(ert-deftest read-large-integer ()
+  (should (eq (type-of (read (format "%d0" most-negative-fixnum))) 'integer))
+  (should (eq (type-of (read (format "%+d" (* -8.0 most-negative-fixnum))))
+              'integer))
+  (should (eq (type-of (read (substring (format "%d" most-negative-fixnum) 1)))
+              'integer))
+  (should (eq (type-of (read (format "#x%x" most-negative-fixnum)))
+              'integer))
+  (should (eq (type-of (read (format "#o%o" most-negative-fixnum)))
+              'integer))
+  (should (eq (type-of (read (format "#32rG%x" most-positive-fixnum)))
+              'integer))
+  (dolist (fmt '("%d" "%s" "#o%o" "#x%x"))
+    (dolist (val (list most-negative-fixnum (1+ most-negative-fixnum)
+		       -1 0 1
+		       (1- most-positive-fixnum) most-positive-fixnum))
+      (should (eq val (read (format fmt val)))))
+    (dolist (val (list (1+ most-positive-fixnum)
+		       (* 2 (1+ most-positive-fixnum))
+		       (* 4 (1+ most-positive-fixnum))
+		       (* 8 (1+ most-positive-fixnum))
+		       18446744073709551616.0))
+      (should (= val (read (format fmt val)))))))
+
+(ert-deftest format-%o-negative-float ()
+  (should (string-equal (format "%o" -1e-37) "0")))
+
+;; Bug#31938
+(ert-deftest format-%d-float ()
+  (should (string-equal (format "%d" -1.1) "-1"))
+  (should (string-equal (format "%d" -0.9) "0"))
+  (should (string-equal (format "%d" -0.0) "0"))
+  (should (string-equal (format "%d" 0.0) "0"))
+  (should (string-equal (format "%d" 0.9) "0"))
+  (should (string-equal (format "%d" 1.1) "1")))
 
 (ert-deftest format-with-field ()
   (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3)
@@ -247,4 +294,136 @@
                  (buffer-string)
                  "foo bar baz qux"))))))
 
+(ert-deftest replace-buffer-contents-bug31837 ()
+  (switch-to-buffer "a")
+  (insert-char (char-from-name "SMILE"))
+  (insert "1234")
+  (switch-to-buffer "b")
+  (insert-char (char-from-name "SMILE"))
+  (insert "5678")
+  (replace-buffer-contents "a")
+  (should (equal (buffer-substring-no-properties (point-min) (point-max))
+                 (concat (string (char-from-name "SMILE")) "1234"))))
+
+(ert-deftest delete-region-undo-markers-1 ()
+  "Make sure we don't end up with freed markers reachable from Lisp."
+  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#40
+  (with-temp-buffer
+    (insert "1234567890")
+    (setq buffer-undo-list nil)
+    (narrow-to-region 2 5)
+    ;; `save-restriction' in a narrowed buffer creates two markers
+    ;; representing the current restriction.
+    (save-restriction
+      (widen)
+      ;; Any markers *within* the deleted region are put onto the undo
+      ;; list.
+      (delete-region 1 6))
+    ;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
+    ;; `buffer-undo-list' is now
+    ;; (("12345" . 1) (#<temp-marker1> . -1) (#<temp-marker2> . 1))
+    ;;
+    ;; If temp-marker1 or temp-marker2 are freed prematurely, calling
+    ;; `type-of' on them will cause Emacs to abort.  Calling
+    ;; `garbage-collect' will also abort if it finds any reachable
+    ;; freed objects.
+    (should (eq (type-of (car (nth 1 buffer-undo-list))) 'marker))
+    (should (eq (type-of (car (nth 2 buffer-undo-list))) 'marker))
+    (garbage-collect)))
+
+(ert-deftest delete-region-undo-markers-2 ()
+  "Make sure we don't end up with freed markers reachable from Lisp."
+  ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#55
+  (with-temp-buffer
+    (insert "1234567890")
+    (setq buffer-undo-list nil)
+    ;; signal_before_change creates markers delimiting a change
+    ;; region.
+    (let ((before-change-functions
+           (list (lambda (beg end)
+                   (delete-region (1- beg) (1+ end))))))
+      (delete-region 2 5))
+    ;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
+    ;; `buffer-undo-list' is now
+    ;; (("678" . 1) ("12345" . 1) (#<marker in no buffer> . -1)
+    ;;  (#<temp-marker1> . -1) (#<temp-marker2> . -4))
+    ;;
+    ;; If temp-marker1 or temp-marker2 are freed prematurely, calling
+    ;; `type-of' on them will cause Emacs to abort.  Calling
+    ;; `garbage-collect' will also abort if it finds any reachable
+    ;; freed objects.
+    (should (eq (type-of (car (nth 3 buffer-undo-list))) 'marker))
+    (should (eq (type-of (car (nth 4 buffer-undo-list))) 'marker))
+    (garbage-collect)))
+
+(ert-deftest format-bignum ()
+  (let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF")
+         (v1 (read (concat "#x" s1)))
+         (s2 "99999999999999999999999999999999")
+         (v2 (read s2))
+         (v3 #x-3ffffffffffffffe000000000000000))
+    (should (> v1 most-positive-fixnum))
+    (should (equal (format "%X" v1) s1))
+    (should (> v2 most-positive-fixnum))
+    (should (equal (format "%d" v2) s2))
+    (should (equal (format "%d" v3) "-5316911983139663489309385231907684352"))
+    (should (equal (format "%+d" v3) "-5316911983139663489309385231907684352"))
+    (should (equal (format "%+d" (- v3))
+                   "+5316911983139663489309385231907684352"))
+    (should (equal (format "% d" (- v3))
+                   " 5316911983139663489309385231907684352"))
+    (should (equal (format "%o" v3)
+                   "-37777777777777777777600000000000000000000"))
+    (should (equal (format "%#50.40x" v3)
+                   "        -0x000000003ffffffffffffffe000000000000000"))
+    (should (equal (format "%-#50.40x" v3)
+                   "-0x000000003ffffffffffffffe000000000000000        "))))
+
+(ert-deftest test-group-name ()
+  (let ((group-name (group-name (group-gid))))
+    ;; If the GID has no associated entry in /etc/group there's no
+    ;; name for it and `group-name' should return nil!
+    (should (or (null group-name) (stringp group-name))))
+  (should-error (group-name 'foo))
+  (cond
+   ((memq system-type '(windows-nt ms-dos))
+    (should-not (group-name 123456789)))
+   ((executable-find "getent")
+    (with-temp-buffer
+      (let (stat name)
+      (dolist (gid (list 0 1212345 (group-gid)))
+        (erase-buffer)
+        (setq stat (ignore-errors
+                     (call-process "getent" nil '(t nil) nil "group"
+                                   (number-to-string gid))))
+        (setq name (group-name gid))
+        (goto-char (point-min))
+        (cond ((eq stat 0)
+               (if (looking-at "\\([[:alnum:]_-]+\\):")
+                   (should (string= (match-string 1) name))))
+              ((eq stat 2)
+               (should-not name)))))))))
+
+(ert-deftest test-translate-region-internal ()
+  (with-temp-buffer
+    (let ((max-char #16r3FFFFF)
+          (tt (make-char-table 'translation-table)))
+      (aset tt max-char ?*)
+      (insert max-char)
+      (translate-region-internal (point-min) (point-max) tt)
+      (should (string-equal (buffer-string) "*")))))
+
+(ert-deftest find-fields ()
+  (with-temp-buffer
+    (insert "foo" (propertize "bar" 'field 'bar) "zot")
+    (goto-char (point-min))
+    (should (= (field-beginning) (point-min)))
+    (should (= (field-end) 4))
+    (goto-char 5)
+    (should (= (field-beginning) 4))
+    (should (= (field-end) 7))
+    (goto-char 8)
+    (should (= (field-beginning) 7))
+    (should (= (field-end) (point-max)))))
+
 ;;; editfns-tests.el ends here