1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 08:43:40 -07:00

Add a testcase for bug#42360

* test/src/comp-tests.el (comp-test-42360): New testcase.

	* test/src/comp-test-funcs.el (comp-test-42360-f): New function.
This commit is contained in:
Andrea Corallo 2020-07-15 23:01:11 +02:00
parent 82169a3d97
commit 2c2cc21f1b
2 changed files with 52 additions and 0 deletions

View file

@ -290,6 +290,53 @@
(declare (speed -1))
3)
(defun comp-test-42360-f (str end-column
&optional start-column padding ellipsis
ellipsis-text-property)
;; From `truncate-string-to-width'. A large enough function to
;; potentially use all registers and that is modifying local
;; variables inside condition-case.
(let ((str-len (length str))
(str-width 14)
(ellipsis-width 3)
(idx 0)
(column 0)
(head-padding "") (tail-padding "")
ch last-column last-idx from-idx)
(condition-case nil
(while (< column start-column)
(setq ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
(args-out-of-range (setq idx str-len)))
(if (< column start-column)
(if padding (make-string end-column padding) "")
(when (and padding (> column start-column))
(setq head-padding (make-string (- column start-column) padding)))
(setq from-idx idx)
(when (>= end-column column)
(condition-case nil
(while (< column end-column)
(setq last-column column
last-idx idx
ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
(args-out-of-range (setq idx str-len)))
(when (> column end-column)
(setq column last-column
idx last-idx))
(when (and padding (< column end-column))
(setq tail-padding (make-string (- end-column column) padding))))
(if (and ellipsis-text-property
(not (equal ellipsis ""))
idx)
(concat head-padding
(substring str from-idx idx)
(propertize (substring str idx) 'display (or ellipsis "")))
(concat head-padding (substring str from-idx idx)
tail-padding ellipsis)))))
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;

View file

@ -363,6 +363,11 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(should (= (comp-test-speed--1-f) 3))
(should-not (subr-native-elisp-p (symbol-function #'comp-test-speed--1-f))))
(ert-deftest comp-test-42360 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-07/msg00418.html>."
(should (string= (comp-test-42360-f "Nel mezzo del " 18 0 32 "yyy" nil)
"Nel mezzo del yyy")))
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;