editfns-tests.el 13.2 KB
Newer Older
1 2
;;; editfns-tests.el -- tests for editfns.c

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17

;; This file is part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
18
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56

;;; Code:

(require 'ert)

(ert-deftest format-properties ()
  ;; Bug #23730
  (should (ert-equal-including-properties
           (format (propertize "%d" 'face '(:background "red")) 1)
           #("1" 0 1 (face (:background "red")))))
  (should (ert-equal-including-properties
           (format (propertize "%2d" 'face '(:background "red")) 1)
           #(" 1" 0 2 (face (:background "red")))))
  (should (ert-equal-including-properties
           (format (propertize "%02d" 'face '(:background "red")) 1)
           #("01" 0 2 (face (:background "red")))))
  (should (ert-equal-including-properties
           (format (concat (propertize "%2d" 'x 'X)
                           (propertize "a" 'a 'A)
                           (propertize "b" 'b 'B))
                   1)
           #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B))))

  ;; Bug #5306
  (should (ert-equal-including-properties
           (format "%.10s"
                   (concat "1234567890aaaa"
                           (propertize "12345678901234567890" 'xxx 25)))
           "1234567890"))
  (should (ert-equal-including-properties
           (format "%.10s"
                   (concat "123456789"
                           (propertize "12345678901234567890" 'xxx 25)))
           #("1234567891" 9 10 (xxx 25))))

  ;; Bug #23859
  (should (ert-equal-including-properties
           (format "%4s" (propertize "hi" 'face 'bold))
57
           #("  hi" 2 4 (face bold))))
58 59 60 61 62 63 64 65 66

  ;; Bug #23897
  (should (ert-equal-including-properties
           (format "%s" (concat (propertize "01234" 'face 'bold) "56789"))
           #("0123456789" 0 5 (face bold))))
  (should (ert-equal-including-properties
           (format "%s" (concat (propertize "01" 'face 'bold)
                                (propertize "23" 'face 'underline)
                                "45"))
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
           #("012345" 0 2 (face bold) 2 4 (face underline))))
  ;; 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
           (format "%12s" (concat (propertize "01234" 'face 'bold) "56789"))
           #("  0123456789" 2 7 (face bold))))
  (should (ert-equal-including-properties
           (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789"))
           #("0123456789  " 0 5 (face bold))))
  (should (ert-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
           (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
           (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)))))
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135

;; Tests for bug#5131.
(defun transpose-test-reverse-word (start end)
  "Reverse characters in a word by transposing pairs of characters."
  (let ((begm (make-marker))
        (endm (make-marker)))
    (set-marker begm start)
    (set-marker endm end)
    (while (> endm begm)
      (progn (transpose-regions begm (1+ begm) endm (1+ endm) t)
             (set-marker begm (1+ begm))
             (set-marker endm (1- endm))))))

(defun transpose-test-get-byte-positions (len)
  "Validate character position to byte position translation."
  (let ((bytes '()))
    (dotimes (pos len)
      (setq bytes (add-to-list 'bytes (position-bytes (1+ pos)) t)))
    bytes))

(ert-deftest transpose-ascii-regions-test ()
  (with-temp-buffer
    (erase-buffer)
    (insert "abcd")
    (transpose-test-reverse-word 1 4)
    (should (string= (buffer-string) "dcba"))
    (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 5)))))

(ert-deftest transpose-nonascii-regions-test-1 ()
  (with-temp-buffer
    (erase-buffer)
    (insert "÷bcd")
    (transpose-test-reverse-word 1 4)
    (should (string= (buffer-string) "dcb÷"))
    (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 6)))))

(ert-deftest transpose-nonascii-regions-test-2 ()
  (with-temp-buffer
    (erase-buffer)
    (insert "÷ab\"äé")
    (transpose-test-reverse-word 1 6)
    (should (string= (buffer-string) "éä\"ba÷"))
    (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10)))))

136 137 138
(ert-deftest format-c-float ()
  (should-error (format "%c" 0.5)))

139 140 141 142
;;; 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 ()
143
  ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs
144 145 146 147 148 149 150
  ;; 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.
151 152 153 154 155 156
  ;;
  ;; 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)"))
157 158 159 160
    ;; 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"))
161
    ;; "UTC0".
162
    (should (string-equal
163 164 165
             (format-time-string format look "UTC0")
             "1972-06-30 23:59:59.999 +0000 (UTC)"))
    ;; Negative UTC offset, as a Lisp list.
166
    (should (string-equal
167 168
             (format-time-string format look '(-28800 "PST"))
             "1972-06-30 15:59:59.999 -0800 (PST)"))
169 170 171
    ;; Negative UTC offset, as a Lisp integer.
    (should (string-equal
             (format-time-string format look -28800)
172 173 174 175 176
             ;; 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)")))
177
    ;; Positive UTC offset that is not an hour multiple, as a string.
178
    (should (string-equal
179 180
             (format-time-string format look "IST-5:30")
             "1972-07-01 05:29:59.999 +0530 (IST)"))))
181 182 183 184

;;; This should not dump core.
(ert-deftest format-time-string-with-outlandish-zone ()
  (should (stringp
185
           (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
186 187
                               (concat (make-string 2048 ?X) "0")))))

188
(ert-deftest format-with-field ()
189
  (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3)
190
                 "First argument 2, then 3, then 1"))
191
  (should (equal (format "a %2$s %3$d %1$d %2$S %3$d %4$d b" 11 "22" 33 44)
192
                 "a 22 33 11 \"22\" 33 44 b"))
193 194
  (should (equal (format "a %08$s %0000000000000000009$s b" 1 2 3 4 5 6 7 8 9)
                 "a 8 9 b"))
195 196
  (should (equal (should-error (format "a %999999$s b" 11))
                 '(error "Not enough arguments for format string")))
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
  (should (equal (should-error (format "a %2147483647$s b"))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error (format "a %9223372036854775807$s b"))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error (format "a %9223372036854775808$s b"))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error (format "a %18446744073709551615$s b"))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error (format "a %18446744073709551616$s b"))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error
                  (format (format "a %%%d$d b" most-positive-fixnum)))
                 '(error "Not enough arguments for format string")))
  (should (equal (should-error
                  (format (format "a %%%d$d b" (+ 1.0 most-positive-fixnum))))
                 '(error "Not enough arguments for format string")))
213
  (should (equal (should-error (format "a %$s b" 11))
214
                 '(error "Invalid format operation %$")))
215
  (should (equal (should-error (format "a %-1$s b" 11))
216 217
                 '(error "Invalid format operation %$")))
  (should (equal (format "%1$c %1$s" ?±) "± 177")))
218

219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
(ert-deftest replace-buffer-contents-1 ()
  (with-temp-buffer
    (insert #("source" 2 4 (prop 7)))
    (let ((source (current-buffer)))
      (with-temp-buffer
        (insert "before dest after")
        (let ((marker (set-marker (make-marker) 14)))
          (save-restriction
            (narrow-to-region 8 12)
            (replace-buffer-contents source))
          (should (equal (marker-buffer marker) (current-buffer)))
          (should (equal (marker-position marker) 16)))
        (should (equal-including-properties
                 (buffer-string)
                 #("before source after" 9 11 (prop 7))))
        (should (equal (point) 9))))
    (should (equal-including-properties
             (buffer-string)
             #("source" 2 4 (prop 7))))))

(ert-deftest replace-buffer-contents-2 ()
  (with-temp-buffer
    (insert "foo bar baz qux")
    (let ((source (current-buffer)))
      (with-temp-buffer
        (insert "foo BAR baz qux")
        (replace-buffer-contents source)
        (should (equal-including-properties
                 (buffer-string)
                 "foo bar baz qux"))))))

250 251 252 253 254 255 256 257 258 259 260
(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"))))

261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311
(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)))

312
;;; editfns-tests.el ends here