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 ;;; Check format-time-string with various TZ settings.
 140 ;;; Use only POSIX-compatible TZ values, since the tests should work
 141 ;;; even if tzdb is not in use.
 142 (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   ;; in MS-Windows (and presumably other) C libraries when formatting
 145   ;; time stamps near the Epoch of 1970-01-01 00:00:00 UTC, and this
 146   ;; test is for GNU Emacs, not for C runtimes.  Instead, look before
 147   ;; you leap: "look" is the timestamp just before the first leap
 148   ;; second on 1972-06-30 23:59:60 UTC, so it should format to the
 149   ;; same string regardless of whether the underlying C library
 150   ;; ignores leap seconds, while avoiding circa-1970 glitches.
 151   ;;
 152   ;; Similarly, stick to the limited set of time zones that are
 153   ;; supported by both POSIX and MS-Windows: exactly 3 ASCII letters
 154   ;; in the abbreviation, and no DST.
 155   (let ((look '(1202 22527 999999 999999))
 156         (format "%Y-%m-%d %H:%M:%S.%3N %z (%Z)"))
 157     ;; UTC.
 158     (should (string-equal
 159              (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
 160              "1972-06-30 23:59:59.999 +0000"))
 161     ;; "UTC0".
 162     (should (string-equal
 163              (format-time-string format look "UTC0")
 164              "1972-06-30 23:59:59.999 +0000 (UTC)"))
 165     ;; Negative UTC offset, as a Lisp list.
 166     (should (string-equal
 167              (format-time-string format look '(-28800 "PST"))
 168              "1972-06-30 15:59:59.999 -0800 (PST)"))
 169     ;; Negative UTC offset, as a Lisp integer.
 170     (should (string-equal
 171              (format-time-string format look -28800)
 172              ;; MS-Windows build replaces unrecognizable TZ values,
 173              ;; such as "-08", with "ZZZ".
 174              (if (eq system-type 'windows-nt)
 175                  "1972-06-30 15:59:59.999 -0800 (ZZZ)"
 176                "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              (format-time-string format look "IST-5:30")
 180              "1972-07-01 05:29:59.999 +0530 (IST)"))))
 181
 182 ;;; This should not dump core.
 183 (ert-deftest format-time-string-with-outlandish-zone ()
 184   (should (stringp
 185            (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil
 186                                (concat (make-string 2048 ?X) "0")))))
 187
 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   (should (equal (format "a %08$s %0000000000000000009$s b" 1 2 3 4 5 6 7 8 9)
 194                  "a 8 9 b"))
 195   (should (equal (should-error (format "a %999999$s b" 11))
 196                  '(error "Not enough arguments for format string")))
 197   (should (equal (should-error (format "a %2147483647$s b"))
 198                  '(error "Not enough arguments for format string")))
 199   (should (equal (should-error (format "a %9223372036854775807$s b"))
 200                  '(error "Not enough arguments for format string")))
 201   (should (equal (should-error (format "a %9223372036854775808$s b"))
 202                  '(error "Not enough arguments for format string")))
 203   (should (equal (should-error (format "a %18446744073709551615$s b"))
 204                  '(error "Not enough arguments for format string")))
 205   (should (equal (should-error (format "a %18446744073709551616$s b"))
 206                  '(error "Not enough arguments for format string")))
 207   (should (equal (should-error
 208                   (format (format "a %%%d$d b" most-positive-fixnum)))
 209                  '(error "Not enough arguments for format string")))
 210   (should (equal (should-error
 211                   (format (format "a %%%d$d b" (+ 1.0 most-positive-fixnum))))
 212                  '(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                  '(error "Invalid format operation %$")))
 217   (should (equal (format "%1$c %1$s" ?±) "± 177")))
 218
 219 (ert-deftest replace-buffer-contents-1 ()
 220   (with-temp-buffer
 221     (insert #("source" 2 4 (prop 7)))
 222     (let ((source (current-buffer)))
 223       (with-temp-buffer
 224         (insert "before dest after")
 225         (let ((marker (set-marker (make-marker) 14)))
 226           (save-restriction
 227             (narrow-to-region 8 12)
 228             (replace-buffer-contents source))
 229           (should (equal (marker-buffer marker) (current-buffer)))
 230           (should (equal (marker-position marker) 16)))
 231         (should (equal-including-properties
 232                  (buffer-string)
 233                  #("before source after" 9 11 (prop 7))))
 234         (should (equal (point) 9))))
 235     (should (equal-including-properties
 236              (buffer-string)
 237              #("source" 2 4 (prop 7))))))
 238
 239 (ert-deftest replace-buffer-contents-2 ()
 240   (with-temp-buffer
 241     (insert "foo bar baz qux")
 242     (let ((source (current-buffer)))
 243       (with-temp-buffer
 244         (insert "foo BAR baz qux")
 245         (replace-buffer-contents source)
 246         (should (equal-including-properties
 247                  (buffer-string)
 248                  "foo bar baz qux"))))))
 249
 250 ;;; editfns-tests.el ends here