code.delx.au - gnu-emacs/blob - test/src/editfns-tests.el

   1 ;;; editfns-tests.el -- tests for editfns.c
   2
   3 ;; Copyright (C) 2016 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 <http://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 ;;; editfns-tests.el ends here