Fix copying text properties in 'format'

* src/editfns.c (styled_format): Fix accounting for text
properties that come from the format string.  (Bug#46317)

* test/src/editfns-tests.el (format-properties): Add new tests for
bug#46317.

diff --git a/src/editfns.c b/src/editfns.c
index e3285494c144b05d0dc4408121345ee2626a2737..991f79abac7a80ce0eb9978e8bf623722743fd0f 100644 (file)
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3134,6 +3134,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
   char *format_start = SSDATA (args[0]);
   bool multibyte_format = STRING_MULTIBYTE (args[0]);
   ptrdiff_t formatlen = SBYTES (args[0]);
+  bool fmt_props = string_intervals (args[0]);
 
   /* Upper bound on number of format specs.  Each uses at least 2 chars.  */
   ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;
@@ -3406,13 +3407,20 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
              convbytes += padding;
              if (convbytes <= buf + bufsize - p)
                {
+                 /* If the format spec has properties, we should account
+                    for the padding on the left in the info[] array.  */
+                 if (fmt_props)
+                   spec->start = nchars;
                  if (! minus_flag)
                    {
                      memset (p, ' ', padding);
                      p += padding;
                      nchars += padding;
                    }
-                 spec->start = nchars;
+                 /* If the properties will come from the argument, we
+                    don't extend them to the left due to padding.  */
+                 if (!fmt_props)
+                   spec->start = nchars;
 
                  if (p > buf
                      && multibyte

diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 64f9137865bcee942dd87a99fa4da8dbb8897966..dcec971c12ec743c2729e7032144d84801ec8222 100644 (file)
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -106,7 +106,27 @@
            #("foobar" 3 6 (face error))))
   (should (ert-equal-including-properties
            (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar")
-           #("foo bar" 4 7 (face error)))))
+           #("foo bar" 4 7 (face error))))
+  ;; Bug #46317
+  (let ((s (propertize "X" 'prop "val")))
+    (should (ert-equal-including-properties
+             (format (concat "%3s/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (ert-equal-including-properties
+             (format (concat "%3S/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (ert-equal-including-properties
+             (format (concat "%3d/" s) 12)
+             #(" 12/X" 4 5 (prop "val"))))
+    (should (ert-equal-including-properties
+             (format (concat "%-3s/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))
+    (should (ert-equal-including-properties
+             (format (concat "%-3S/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))
+    (should (ert-equal-including-properties
+             (format (concat "%-3d/" s) 12)
+             #("12 /X" 4 5 (prop "val"))))))
 
 ;; Tests for bug#5131.
 (defun transpose-test-reverse-word (start end)