feature/native-comp 2c2cc21 3/4: Add a testcase for bug#42360

[Andrea Corallo]

branch: feature/native-comp
commit 2c2cc21f1be721e5ba30fa22aedeb5c254791193
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    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.
---
 test/src/comp-test-funcs.el | 47 +++++++++++++++++++++++++++++++++++++++++++++
 test/src/comp-tests.el      |  5 +++++
 2 files changed, 52 insertions(+)

diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index 2fe6276..fe9943a 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -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 ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8f0b90f..0925045 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -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. ;;