1;;; redisplay-testsuite.el --- Test suite for redisplay. -*- lexical-binding: t; -*- 2 3;; Copyright (C) 2009-2021 Free Software Foundation, Inc. 4 5;; Author: Chong Yidong <cyd@stupidchicken.com> 6;; Keywords: internal 7;; Human-Keywords: internal 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software: you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation, either version 3 of the License, or 14;; (at your option) any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 24;;; Commentary: 25 26;; Type M-x test-redisplay RET to generate the test buffer. 27 28;;; Code: 29 30(defun test-insert-overlay (text &rest props) 31 (let ((opoint (point)) 32 overlay) 33 (insert text) 34 (setq overlay (make-overlay opoint (point))) 35 (while props 36 (overlay-put overlay (car props) (cadr props)) 37 (setq props (cddr props))) 38 overlay)) 39 40(defun test-redisplay-1 () 41 (insert "Test 1: Displaying adjacent and overlapping overlays:\n\n") 42 (insert " Expected: gnu emacs\n") 43 (insert " Results: ") 44 (test-insert-overlay "n" 'before-string "g" 'after-string "u ") 45 (test-insert-overlay "ma" 'before-string "e" 'after-string "cs") 46 (insert "\n\n") 47 (insert " Expected: gnu emacs\n") 48 (insert " Results: ") 49 (test-insert-overlay "u" 'before-string "gn") 50 (test-insert-overlay "ma" 'before-string " e" 'after-string "cs") 51 (insert "\n\n") 52 (insert " Expected: gnu emacs\n") 53 (insert " Results: ") 54 (test-insert-overlay "XXX" 'display "u " 55 'before-string "gn" 'after-string "em") 56 (test-insert-overlay "a" 'after-string "cs") 57 (insert "\n\n") 58 (insert " Expected: gnu emacs\n") 59 (insert " Results: ") 60 (test-insert-overlay "u " 'before-string "gn" 'after-string "em") 61 (test-insert-overlay "XXX" 'display "a" 'after-string "cs") 62 (insert "\n\n")) 63 64(defun test-redisplay-2 () 65 (insert "Test 2: Mouse highlighting. Move your mouse over the letters XXX:\n\n") 66 (insert " Expected: " 67 (propertize "xxxXXXxxx" 'face 'highlight) 68 "...---...\n Test: ") 69 (test-insert-overlay "XXX" 'before-string "xxx" 'after-string "xxx" 70 'mouse-face 'highlight ) 71 (test-insert-overlay "---" 'before-string "..." 'after-string "...") 72 (insert "\n\n Expected: " 73 (propertize "xxxXXX" 'face 'highlight) 74 "...---...\n Test: ") 75 (test-insert-overlay "XXX" 'before-string "xxx" 'mouse-face 'highlight) 76 (test-insert-overlay "---" 'before-string "..." 'after-string "...") 77 (insert "\n\n Expected: " 78 (propertize "XXX" 'face 'highlight) 79 "...---...\n Test: ") 80 (test-insert-overlay "..." 'display "XXX" 'mouse-face 'highlight) 81 (test-insert-overlay "---" 'before-string "..." 'after-string "...") 82 (insert "\n\n Expected: " 83 (propertize "XXXxxx" 'face 'highlight) 84 "...\n Test: ") 85 (test-insert-overlay "..." 'display "XXX" 'after-string "xxx" 86 'mouse-face 'highlight) 87 (test-insert-overlay "error" 'display "...") 88 (insert "\n\n Expected: " 89 "---..." 90 (propertize "xxxXXX" 'face 'highlight) 91 "\n Test: ") 92 (test-insert-overlay "xxx" 'display "---" 'after-string "...") 93 (test-insert-overlay "error" 'before-string "xxx" 'display "XXX" 94 'mouse-face 'highlight) 95 (insert "\n\n Expected: " 96 "...---..." 97 (propertize "xxxXXXxxx" 'face 'highlight) 98 "\n Test: ") 99 (test-insert-overlay "---" 'before-string "..." 'after-string "...") 100 (test-insert-overlay "XXX" 'before-string "xxx" 'after-string "xxx" 101 'mouse-face 'highlight) 102 (insert "\n\n Expected: " 103 "..." 104 (propertize "XXX" 'face 'highlight) 105 "...\n Test: ") 106 (test-insert-overlay "---" 107 'display (propertize "XXX" 'mouse-face 'highlight) 108 'before-string "..." 109 'after-string "...") 110 (insert "\n\n Expected: " 111 (propertize "XXX\n" 'face 'highlight) 112 "\n Test: ") 113 (test-insert-overlay "XXX\n" 'mouse-face 'highlight) 114 (insert "\n\n")) 115 116(defun test-redisplay-3 () 117 (insert "Test 3: Overlay with strings and images:\n\n") 118 (let ((img-data "#define x_width 8 119#define x_height 8 120static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff };")) 121 ;; Control 122 (insert " Expected: AB" 123 (propertize "X" 'display `(image :data ,img-data :type xbm)) 124 "CD\n") 125 126 ;; Overlay with before, after, and image display string. 127 (insert " Result 1: ") 128 (let ((opoint (point))) 129 (insert "AXD\n") 130 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 131 (overlay-put ov 'before-string "B") 132 (overlay-put ov 'after-string "C") 133 (overlay-put ov 'display 134 `(image :data ,img-data :type xbm)))) 135 136 ;; Overlay with before and after string, and image text prop. 137 (insert " Result 2: ") 138 (let ((opoint (point))) 139 (insert "AXD\n") 140 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 141 (overlay-put ov 'before-string "B") 142 (overlay-put ov 'after-string "C") 143 (put-text-property (1+ opoint) (+ 2 opoint) 'display 144 `(image :data ,img-data :type xbm)))) 145 146 ;; Overlays with adjacent before and after strings, and image text 147 ;; prop. 148 (insert " Result 3: ") 149 (let ((opoint (point))) 150 (insert "AXD\n") 151 (let ((ov1 (make-overlay opoint (1+ opoint))) 152 (ov2 (make-overlay (+ 2 opoint) (+ 3 opoint)))) 153 (overlay-put ov1 'after-string "B") 154 (overlay-put ov2 'before-string "C") 155 (put-text-property (1+ opoint) (+ 2 opoint) 'display 156 `(image :data ,img-data :type xbm)))) 157 158 ;; Three overlays. 159 (insert " Result 4: ") 160 (let ((opoint (point))) 161 (insert "AXD\n\n") 162 (let ((ov1 (make-overlay opoint (1+ opoint))) 163 (ov2 (make-overlay (+ 2 opoint) (+ 3 opoint))) 164 (ov3 (make-overlay (1+ opoint) (+ 2 opoint)))) 165 (overlay-put ov1 'after-string "B") 166 (overlay-put ov2 'before-string "C") 167 (overlay-put ov3 'display `(image :data ,img-data :type xbm)))))) 168 169(defun test-redisplay-4 () 170 (insert "Test 4: Overlay strings and invisibility:\n\n") 171 ;; Before and after strings with non-nil `invisibility'. 172 (insert " Expected: ABC\n") 173 (insert " Result: ") 174 (let ((opoint (point))) 175 (insert "ABC\n") 176 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 177 (overlay-put ov 'before-string 178 (propertize "XX" 'invisible 179 'test-redisplay--simple-invis)) 180 (overlay-put ov 'after-string 181 (propertize "XX" 'invisible 182 'test-redisplay--simple-invis)))) 183 184 ;; Before and after strings bogus `invisibility' property (value is 185 ;; not listed in `buffer-invisibility-spec'). 186 (insert "\n Expected: ABC") 187 (insert "\n Result: ") 188 (let ((opoint (point))) 189 (insert "B\n") 190 (let ((ov (make-overlay opoint (1+ opoint)))) 191 (overlay-put ov 'before-string 192 (propertize "A" 'invisible 'bogus-invis-spec)) 193 (overlay-put ov 'after-string 194 (propertize "C" 'invisible 'bogus-invis-spec)))) 195 196 ;; Before/after string with ellipsis `invisibility' property. 197 (insert "\n Expected: ...B...") 198 (insert "\n Result: ") 199 (let ((opoint (point))) 200 (insert "B\n") 201 (let ((ov (make-overlay opoint (1+ opoint)))) 202 (overlay-put ov 'before-string 203 (propertize "A" 'invisible 'test-redisplay--ellipsis-invis)) 204 (overlay-put ov 'after-string 205 (propertize "C" 'invisible 'test-redisplay--ellipsis-invis)))) 206 207 ;; Before/after string with partial ellipsis `invisibility' property. 208 (insert "\n Expected: A...ABC...C") 209 (insert "\n Result: ") 210 (let ((opoint (point))) 211 (insert "B\n") 212 (let ((ov (make-overlay opoint (1+ opoint))) 213 (a "AAA") 214 (c "CCC")) 215 (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis a) 216 (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis c) 217 (overlay-put ov 'before-string a) 218 (overlay-put ov 'after-string c))) 219 220 ;; Display string with `invisibility' property. 221 (insert "\n Expected: ABC") 222 (insert "\n Result: ") 223 (let ((opoint (point))) 224 (insert "AYBC\n") 225 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 226 (overlay-put ov 'display 227 (propertize "XX" 'invisible 228 'test-redisplay--simple-invis)))) 229 ;; Display string with bogus `invisibility' property. 230 (insert "\n Expected: ABC") 231 (insert "\n Result: ") 232 (let ((opoint (point))) 233 (insert "AXC\n") 234 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 235 (overlay-put ov 'display 236 (propertize "B" 'invisible 'bogus-invis-spec)))) 237 ;; Display string with ellipsis `invisibility' property. 238 (insert "\n Expected: A...C") 239 (insert "\n Result: ") 240 (let ((opoint (point))) 241 (insert "AXC\n") 242 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))) 243 (overlay-put ov 'display 244 (propertize "B" 'invisible 245 'test-redisplay--ellipsis-invis)))) 246 ;; Display string with partial `invisibility' property. 247 (insert "\n Expected: A...C") 248 (insert "\n Result: ") 249 (let ((opoint (point))) 250 (insert "X\n") 251 (let ((ov (make-overlay opoint (1+ opoint))) 252 (str "ABC")) 253 (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str) 254 (overlay-put ov 'display str))) 255 ;; Overlay string over invisible text and non-default face. 256 (insert "\n Expected: ..." (propertize "ABC" 'face 'highlight) "XYZ") 257 (insert "\n Result: ") 258 (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis)) 259 (let ((ov (make-overlay (point) (point)))) 260 (overlay-put ov 'invisible t) 261 (overlay-put ov 'window (selected-window)) 262 (overlay-put ov 'after-string 263 (propertize "ABC" 'face 'highlight))) 264 (insert "XYZ\n") 265 ;; Overlay strings with partial `invisibility' property and with a 266 ;; display property on the before-string. 267 (insert "\n Expected: ..." 268 (propertize "DEF" 'display '(image :type xpm :file "close.xpm")) 269 (propertize "ABC" 'face 'highlight) "XYZ") 270 (insert "\n Result: ") 271 (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis)) 272 (let ((ov (make-overlay (point) (point)))) 273 (overlay-put ov 'invisible t) 274 (overlay-put ov 'window (selected-window)) 275 (overlay-put ov 'after-string 276 (propertize "ABC" 'face 'highlight)) 277 (overlay-put ov 'before-string 278 (propertize "DEF" 279 'display '(image :type xpm :file "close.xpm")))) 280 (insert "XYZ\n") 281 282 ;; Overlay string with 2 adjacent and different invisible 283 ;; properties. This caused an infloop before Emacs 25. 284 (insert "\n Expected: ABC") 285 (insert "\n Result: ") 286 (let ((opoint (point))) 287 (insert "ABC\n") 288 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))) 289 (str (concat (propertize "X" 290 'invisible 'test-redisplay--simple-invis) 291 (propertize "Y" 292 'invisible 'test-redisplay--simple-invis2)))) 293 (overlay-put ov 'after-string str))) 294 295 (insert "\n")) 296 297(defvar test-redisplay-5a-expected-overlay nil) 298(defvar test-redisplay-5a-result-overlay nil) 299(defvar test-redisplay-5b-expected-overlay nil) 300(defvar test-redisplay-5b-result-overlay nil) 301 302(defun test-redisplay-5-toggle (_event) 303 (interactive "e") 304 (setq display-raw-bytes-as-hex (not display-raw-bytes-as-hex)) 305 (let ((label (if display-raw-bytes-as-hex "\\x80" "\\200"))) 306 (overlay-put test-redisplay-5a-expected-overlay 'display 307 (propertize label 'face 'escape-glyph))) 308 (let ((label (if display-raw-bytes-as-hex "\\x3fffc" "\\777774"))) 309 (overlay-put test-redisplay-5b-expected-overlay 'display 310 (propertize label 'face 'escape-glyph)))) 311 312(defun test-redisplay-5 () 313 (insert "Test 5: Display of raw bytes:\n\n") 314 (insert " Expected: ") 315 (setq test-redisplay-5a-expected-overlay 316 (test-insert-overlay " " 'display 317 (propertize "\\200" 'face 'escape-glyph))) 318 (insert "\n Result: ") 319 (setq test-redisplay-5a-result-overlay 320 (test-insert-overlay " " 'display "\200")) 321 (insert "\n\n") 322 (insert " Expected: ") 323 ;; This tests a large codepoint, to make sure the internal buffer we 324 ;; use to produce the representation is large enough. 325 (aset printable-chars #x3fffc nil) 326 (setq test-redisplay-5b-expected-overlay 327 (test-insert-overlay " " 'display 328 (propertize "\\777774" 'face 'escape-glyph))) 329 (insert "\n Result: ") 330 (setq test-redisplay-5b-result-overlay 331 (test-insert-overlay " " 'display (char-to-string #x3fffc))) 332 (insert "\n\n") 333 (insert-button "Toggle between octal and hex display" 334 'action 'test-redisplay-5-toggle)) 335 336(defun test-redisplay () 337 (interactive) 338 (let ((buf (get-buffer "*Redisplay Test*"))) 339 (if buf 340 (kill-buffer buf)) 341 (switch-to-buffer (get-buffer-create "*Redisplay Test*")) 342 (erase-buffer) 343 (setq buffer-invisibility-spec 344 '(test-redisplay--simple-invis 345 test-redisplay--simple-invis2 346 (test-redisplay--ellipsis-invis . t))) 347 (test-redisplay-1) 348 (test-redisplay-2) 349 (test-redisplay-3) 350 (test-redisplay-4) 351 (test-redisplay-5) 352 (goto-char (point-min)))) 353 354;;; redisplay-testsuite.el ends here 355