test/src/editfns-tests.el

   1 ;;; editfns-tests.el -- tests for editfns.c
   2
   3 ;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; 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 ;;; Code:
  21
  22 (require 'ert)
  23
  24 (ert-deftest format-properties ()
  25   ;; Bug #23730
  26   (should (ert-equal-including-properties
  27            (format (propertize "%d" 'face '(:background "red")) 1)
  28            #("1" 0 1 (face (:background "red")))))
  29   (should (ert-equal-including-properties
  30            (format (propertize "%2d" 'face '(:background "red")) 1)
  31            #(" 1" 0 2 (face (:background "red")))))
  32   (should (ert-equal-including-properties
  33            (format (propertize "%02d" 'face '(:background "red")) 1)
  34            #("01" 0 2 (face (:background "red")))))
  35   (should (ert-equal-including-properties
  36            (format (concat (propertize "%2d" 'x 'X)
  37                            (propertize "a" 'a 'A)
  38                            (propertize "b" 'b 'B))
  39                    1)
  40            #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B))))
  41
  42   ;; Bug #5306
  43   (should (ert-equal-including-properties
  44            (format "%.10s"
  45                    (concat "1234567890aaaa"
  46                            (propertize "12345678901234567890" 'xxx 25)))
  47            "1234567890"))
  48   (should (ert-equal-including-properties
  49            (format "%.10s"
  50                    (concat "123456789"
  51                            (propertize "12345678901234567890" 'xxx 25)))
  52            #("1234567891" 9 10 (xxx 25))))
  53
  54   ;; Bug #23859
  55   (should (ert-equal-including-properties
  56            (format "%4s" (propertize "hi" 'face 'bold))
  57            #("  hi" 2 4 (face bold))))
  58
  59   ;; Bug #23897
  60   (should (ert-equal-including-properties
  61            (format "%s" (concat (propertize "01234" 'face 'bold) "56789"))
  62            #("0123456789" 0 5 (face bold))))
  63   (should (ert-equal-including-properties
  64            (format "%s" (concat (propertize "01" 'face 'bold)
  65                                 (propertize "23" 'face 'underline)
  66                                 "45"))
  67            #("012345" 0 2 (face bold) 2 4 (face underline))))
  68   ;; The last property range is extended to include padding on the
  69   ;; right, but the first range is not extended to the left to include
  70   ;; padding on the left!
  71   (should (ert-equal-including-properties
  72            (format "%12s" (concat (propertize "01234" 'face 'bold) "56789"))
  73            #("  0123456789" 2 7 (face bold))))
  74   (should (ert-equal-including-properties
  75            (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789"))
  76            #("0123456789  " 0 5 (face bold))))
  77   (should (ert-equal-including-properties
  78            (format "%10s" (concat (propertize "01" 'face 'bold)
  79                                   (propertize "23" 'face 'underline)
  80                                   "45"))
  81            #("    012345" 4 6 (face bold) 6 8 (face underline))))
  82   (should (ert-equal-including-properties
  83            (format "%-10s" (concat (propertize "01" 'face 'bold)
  84                                    (propertize "23" 'face 'underline)
  85                                    "45"))
  86            #("012345    " 0 2 (face bold) 2 4 (face underline))))
  87   (should (ert-equal-including-properties
  88            (format "%-10s" (concat (propertize "01" 'face 'bold)
  89                                    (propertize "23" 'face 'underline)
  90                                    (propertize "45" 'face 'italic)))
  91            #("012345    " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))))
  92
  93 ;; Tests for bug#5131.
  94 (defun transpose-test-reverse-word (start end)
  95   "Reverse characters in a word by transposing pairs of characters."
  96   (let ((begm (make-marker))
  97         (endm (make-marker)))
  98     (set-marker begm start)
  99     (set-marker endm end)
 100     (while (> endm begm)
 101       (progn (transpose-regions begm (1+ begm) endm (1+ endm) t)
 102              (set-marker begm (1+ begm))
 103              (set-marker endm (1- endm))))))
 104
 105 (defun transpose-test-get-byte-positions (len)
 106   "Validate character position to byte position translation."
 107   (let ((bytes '()))
 108     (dotimes (pos len)
 109       (setq bytes (add-to-list 'bytes (position-bytes (1+ pos)) t)))
 110     bytes))
 111
 112 (ert-deftest transpose-ascii-regions-test ()
 113   (with-temp-buffer
 114     (erase-buffer)
 115     (insert "abcd")
 116     (transpose-test-reverse-word 1 4)
 117     (should (string= (buffer-string) "dcba"))
 118     (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 5)))))
 119
 120 (ert-deftest transpose-nonascii-regions-test-1 ()
 121   (with-temp-buffer
 122     (erase-buffer)
 123     (insert "÷bcd")
 124     (transpose-test-reverse-word 1 4)
 125     (should (string= (buffer-string) "dcb÷"))
 126     (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 6)))))
 127
 128 (ert-deftest transpose-nonascii-regions-test-2 ()
 129   (with-temp-buffer
 130     (erase-buffer)
 131     (insert "÷ab\"äé")
 132     (transpose-test-reverse-word 1 6)
 133     (should (string= (buffer-string) "éä\"ba÷"))
 134     (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10)))))
 135
 136 (ert-deftest format-c-float ()
 137   (should-error (format "%c" 0.5)))
 138
 139 ;;; Test for Bug#29609.
 140 (ert-deftest format-sharp-0-x ()
 141   (should (string-equal (format "%#08x" #x10) "0x000010"))
 142   (should (string-equal (format "%#05X" #x10) "0X010"))
 143   (should (string-equal (format "%#04x" 0) "0000")))
 144
 145
 146 ;;; Tests for Bug#30408.
 147
 148 (ert-deftest format-%d-large-float ()
 149   (should (string-equal (format "%d" 18446744073709551616.0)
 150                         "18446744073709551616"))
 151   (should (string-equal (format "%d" -18446744073709551616.0)
 152                         "-18446744073709551616")))
 153
 154 ;;; Perhaps Emacs will be improved someday to return the correct
 155 ;;; answer for positive numbers instead of overflowing; in
 156 ;;; that case these tests will need to be changed.  In the meantime make
 157 ;;; sure Emacs is reporting the overflow correctly.
 158 (ert-deftest format-%x-large-float ()
 159   (should-error (format "%x" 18446744073709551616.0)
 160                 :type 'overflow-error))
 161 (ert-deftest read-large-integer ()
 162   (should-error (read (format "%d0" most-negative-fixnum))
 163                 :type 'overflow-error)
 164   (should-error (read (format "%+d" (* -8.0 most-negative-fixnum)))
 165                 :type 'overflow-error)
 166   (should-error (read (substring (format "%d" most-negative-fixnum) 1))
 167                 :type 'overflow-error)
 168   (should-error (read (format "#x%x" most-negative-fixnum))
 169                 :type 'overflow-error)
 170   (should-error (read (format "#o%o" most-negative-fixnum))
 171                 :type 'overflow-error)
 172   (should-error (read (format "#32rG%x" most-positive-fixnum))
 173                 :type 'overflow-error))
 174
 175 (ert-deftest format-%o-invalid-float ()
 176   (should-error (format "%o" -1e-37)
 177                 :type 'overflow-error))
 178
 179 ;; Bug#31938
 180 (ert-deftest format-%d-float ()
 181   (should (string-equal (format "%d" -1.1) "-1"))
 182   (should (string-equal (format "%d" -0.9) "0"))
 183   (should (string-equal (format "%d" -0.0) "0"))
 184   (should (string-equal (format "%d" 0.0) "0"))
 185   (should (string-equal (format "%d" 0.9) "0"))
 186   (should (string-equal (format "%d" 1.1) "1")))
 187
 188 ;;; Check format-time-string with various TZ settings.
 189 ;;; Use only POSIX-compatible TZ values, since the tests should work
 190 ;;; even if tzdb is not in use.
 191 (ert-deftest format-time-string-with-zone ()
 192   ;; Don’t use (0 0 0 0) as the test case, as there are too many bugs
 193   ;; in MS-Windows (and presumably other) C libraries when formatting
 194   ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
 195   ;; test is for GNU Emacs, not for C runtimes.  Instead, look before
 196   ;; you leap: "look" is the timestamp just before the first leap
 197   ;; second on 1972-06-30 23:59:60 UTC, so it should format to the
 198   ;; same string regardless of whether the underlying C library
 199   ;; ignores leap seconds, while avoiding circa-1970 glitches.
 200   ;;
 201   ;; Similarly, stick to the limited set of time zones that are
 202   ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
 203   ;; in the abbreviation, and no DST.
 204   (let ((look '(1202 22527 999999 999999))
 205         (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
 206     ;; UTC.
 207     (should (string-equal
 208              (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
 209              "1972-06-30 23:59:59.999 +0000"))
 210     ;; "UTC0".
 211     (should (string-equal
 212              (format-time-string format look "UTC0")
 213              "1972-06-30 23:59:59.999 +0000 (UTC)"))
 214     ;; Negative UTC offset, as a Lisp list.
 215     (should (string-equal
 216              (format-time-string format look '(-28800 "PST"))
 217              "1972-06-30 15:59:59.999 -0800 (PST)"))
 218     ;; Negative UTC offset, as a Lisp integer.
 219     (should (string-equal
 220              (format-time-string format look -28800)
 221              ;; MS-Windows build replaces unrecognizable TZ values,
 222              ;; such as "-08", with "ZZZ".
 223              (if (eq system-type 'windows-nt)
 224                  "1972-06-30 15:59:59.999 -0800 (ZZZ)"
 225                "1972-06-30 15:59:59.999 -0800 (-08)")))
 226     ;; Positive UTC offset that is not an hour multiple, as a string.
 227     (should (string-equal
 228              (format-time-string format look "IST-5:30")
 229              "1972-07-01 05:29:59.999 +0530 (IST)"))))
 230
 231 ;;; This should not dump core.
 232 (ert-deftest format-time-string-with-outlandish-zone ()
 233   (should (stringp
 234            (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
 235                                (concat (make-string 2048 ?X) "0")))))
 236
 237 (ert-deftest format-with-field ()
 238   (should (equal (format "First argument %2$s, then %3$s, then %1$s" 1 2 3)
 239                  "First argument 2, then 3, then 1"))
 240   (should (equal (format "a %2$s %3$d %1$d %2$S %3$d %4$d b" 11 "22" 33 44)
 241                  "a 22 33 11 \"22\" 33 44 b"))
 242   (should (equal (format "a %08$s %0000000000000000009$s b" 1 2 3 4 5 6 7 8 9)
 243                  "a 8 9 b"))
 244   (should (equal (should-error (format "a %999999$s b" 11))
 245                  '(error "Not enough arguments for format string")))
 246   (should (equal (should-error (format "a %2147483647$s b"))
 247                  '(error "Not enough arguments for format string")))
 248   (should (equal (should-error (format "a %9223372036854775807$s b"))
 249                  '(error "Not enough arguments for format string")))
 250   (should (equal (should-error (format "a %9223372036854775808$s b"))
 251                  '(error "Not enough arguments for format string")))
 252   (should (equal (should-error (format "a %18446744073709551615$s b"))
 253                  '(error "Not enough arguments for format string")))
 254   (should (equal (should-error (format "a %18446744073709551616$s b"))
 255                  '(error "Not enough arguments for format string")))
 256   (should (equal (should-error
 257                   (format (format "a %%%d$d b" most-positive-fixnum)))
 258                  '(error "Not enough arguments for format string")))
 259   (should (equal (should-error
 260                   (format (format "a %%%d$d b" (+ 1.0 most-positive-fixnum))))
 261                  '(error "Not enough arguments for format string")))
 262   (should (equal (should-error (format "a %$s b" 11))
 263                  '(error "Invalid format operation %$")))
 264   (should (equal (should-error (format "a %-1$s b" 11))
 265                  '(error "Invalid format operation %$")))
 266   (should (equal (format "%1$c %1$s" ?±) "± 177")))
 267
 268 (ert-deftest replace-buffer-contents-1 ()
 269   (with-temp-buffer
 270     (insert #("source" 2 4 (prop 7)))
 271     (let ((source (current-buffer)))
 272       (with-temp-buffer
 273         (insert "before dest after")
 274         (let ((marker (set-marker (make-marker) 14)))
 275           (save-restriction
 276             (narrow-to-region 8 12)
 277             (replace-buffer-contents source))
 278           (should (equal (marker-buffer marker) (current-buffer)))
 279           (should (equal (marker-position marker) 16)))
 280         (should (equal-including-properties
 281                  (buffer-string)
 282                  #("before source after" 9 11 (prop 7))))
 283         (should (equal (point) 9))))
 284     (should (equal-including-properties
 285              (buffer-string)
 286              #("source" 2 4 (prop 7))))))
 287
 288 (ert-deftest replace-buffer-contents-2 ()
 289   (with-temp-buffer
 290     (insert "foo bar baz qux")
 291     (let ((source (current-buffer)))
 292       (with-temp-buffer
 293         (insert "foo BAR baz qux")
 294         (replace-buffer-contents source)
 295         (should (equal-including-properties
 296                  (buffer-string)
 297                  "foo bar baz qux"))))))
 298
 299 (ert-deftest replace-buffer-contents-bug31837 ()
 300   (switch-to-buffer "a")
 301   (insert-char (char-from-name "SMILE"))
 302   (insert "1234")
 303   (switch-to-buffer "b")
 304   (insert-char (char-from-name "SMILE"))
 305   (insert "5678")
 306   (replace-buffer-contents "a")
 307   (should (equal (buffer-substring-no-properties (point-min) (point-max))
 308                  (concat (string (char-from-name "SMILE")) "1234"))))
 309
 310 (ert-deftest delete-region-undo-markers-1 ()
 311   "Make sure we don't end up with freed markers reachable from Lisp."
 312   ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#40
 313   (with-temp-buffer
 314     (insert "1234567890")
 315     (setq buffer-undo-list nil)
 316     (narrow-to-region 2 5)
 317     ;; `save-restriction' in a narrowed buffer creates two markers
 318     ;; representing the current restriction.
 319     (save-restriction
 320       (widen)
 321       ;; Any markers *within* the deleted region are put onto the undo
 322       ;; list.
 323       (delete-region 1 6))
 324     ;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
 325     ;; `buffer-undo-list' is now
 326     ;; (("12345" . 1) (#<temp-marker1> . -1) (#<temp-marker2> . 1))
 327     ;;
 328     ;; If temp-marker1 or temp-marker2 are freed prematurely, calling
 329     ;; `type-of' on them will cause Emacs to abort.  Calling
 330     ;; `garbage-collect' will also abort if it finds any reachable
 331     ;; freed objects.
 332     (should (eq (type-of (car (nth 1 buffer-undo-list))) 'marker))
 333     (should (eq (type-of (car (nth 2 buffer-undo-list))) 'marker))
 334     (garbage-collect)))
 335
 336 (ert-deftest delete-region-undo-markers-2 ()
 337   "Make sure we don't end up with freed markers reachable from Lisp."
 338   ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#55
 339   (with-temp-buffer
 340     (insert "1234567890")
 341     (setq buffer-undo-list nil)
 342     ;; signal_before_change creates markers delimiting a change
 343     ;; region.
 344     (let ((before-change-functions
 345            (list (lambda (beg end)
 346                    (delete-region (1- beg) (1+ end))))))
 347       (delete-region 2 5))
 348     ;; (princ (format "%S" buffer-undo-list) #'external-debugging-output)
 349     ;; `buffer-undo-list' is now
 350     ;; (("678" . 1) ("12345" . 1) (#<marker in no buffer> . -1)
 351     ;;  (#<temp-marker1> . -1) (#<temp-marker2> . -4))
 352     ;;
 353     ;; If temp-marker1 or temp-marker2 are freed prematurely, calling
 354     ;; `type-of' on them will cause Emacs to abort.  Calling
 355     ;; `garbage-collect' will also abort if it finds any reachable
 356     ;; freed objects.
 357     (should (eq (type-of (car (nth 3 buffer-undo-list))) 'marker))
 358     (should (eq (type-of (car (nth 4 buffer-undo-list))) 'marker))
 359     (garbage-collect)))
 360
 361 ;;; editfns-tests.el ends here