andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix off-by-one error in string-truncate-left

Browse source 
* lisp/emacs-lisp/subr-x.el (string-truncate-left): Fix off-by-one
error (bug#56685).
This commit is contained in:
Lars Ingebrigtsen 2022-07-23 08:55:20 +02:00
parent 33602132ac
commit 51f5c4b773
2 changed files with 11 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/emacs-lisp/subr-x.el
View file

@ -107,12 +107,16 @@ characters; nil stands for the empty string."
;;;###autoload ;;;###autoload
(defun string-truncate-left (string length) (defun string-truncate-left (string length)
"Truncate STRING to LENGTH, replacing initial surplus with \"...\"." "If STRING is longer than LENGTH, return a truncated version.
When truncating, \"...\" is always prepended to the string, so
the resulting string may be longer than the original if LENGTH is
3 or smaller."
(let ((strlen (length string))) (let ((strlen (length string)))
(if (<= strlen length) (if (<= strlen length)
string string
(setq length (max 0 (- length 3))) (setq length (max 0 (- length 3)))
(concat "..." (substring string (max 0 (- strlen 1 length))))))) (concat "..." (substring string (min (1- strlen)
(max 0 (- strlen length))))))))
(defsubst string-blank-p (string) (defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace. "Check whether STRING is either empty or only whitespace.

5
test/lisp/emacs-lisp/subr-x-tests.el
View file

@ -766,5 +766,10 @@
(should (equal (sort (hash-table-keys h) #'string<) '(a b c))) (should (equal (sort (hash-table-keys h) #'string<) '(a b c)))
(should (equal (sort (hash-table-values h) #'<) '(1 2 3))))) (should (equal (sort (hash-table-values h) #'<) '(1 2 3)))))
(ert-deftest test-string-truncate-left ()
(should (equal (string-truncate-left "band" 3) "...d"))
(should (equal (string-truncate-left "band" 2) "...d"))
(should (equal (string-truncate-left "longstring" 8) "...tring")))
(provide 'subr-x-tests) (provide 'subr-x-tests)
;;; subr-x-tests.el ends here ;;; subr-x-tests.el ends here