Document and ensure that sv_catpvf() does no argument ordering

sv_catpvf() and friends ultimately end up calling sv_vcatpvfn_flags() with a
C-style va_list argument (rather than with an array of SV pointers). When
the sprintf implementation in sv_vcatpvfn_flags() is called with a va_list
it always ignores any attempt by the format string to reorder the arguments.
This reasonable limitation is now documented, and the implementation throws
an exception when it encounters this situation.

Minimal tests for these exceptions have been added to XS::APItest.

diff --git a/MANIFEST b/MANIFEST
index bfdabac..61437ba 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3963,6 +3963,7 @@ ext/XS-APItest/t/stmtsasexpr.t    test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string
 ext/XS-APItest/t/stuff_svcur_bug.t     test for a bug in lex_stuff_pvn
 ext/XS-APItest/t/subcall.t     Test XSUB calls
+ext/XS-APItest/t/svcatpvf.t    Test sv_catpvf argument reordering
 ext/XS-APItest/t/svcat.t       Test sv_catpvn
 ext/XS-APItest/t/sviscow.t     Test SvIsCOW
 ext/XS-APItest/t/svpeek.t      XS::APItest extension

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 28d6bec..93b3cb6 100644 (file)
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '0.73';
+our $VERSION = '0.74';
 
 require XSLoader;
 

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index aef0572..7a258de 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3884,6 +3884,16 @@ test_newOP_CUSTOM()
     OUTPUT:
        RETVAL
 
+void
+test_sv_catpvf(SV *fmtsv)
+    PREINIT:
+        SV *sv;
+        char *fmt;
+    CODE:
+        fmt = SvPV_nolen(fmtsv);
+        sv = sv_2mortal(newSVpvn("", 0));
+        sv_catpvf(sv, fmt, 5, 6, 7, 8);
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int

diff --git a/ext/XS-APItest/t/svcatpvf.t b/ext/XS-APItest/t/svcatpvf.t
new file mode 100644 (file)
index 0000000..1534889
--- /dev/null
+++ b/ext/XS-APItest/t/svcatpvf.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use XS::APItest;
+
+my @cases = (
+    [field     => '%2$d'],
+    [precision => '%.*2$d'],
+    [vector    => '%2$vd'],
+    [width     => '%*2$d'],
+);
+
+for my $case (@cases) {
+    my ($what, $format) = @$case;
+    my $got = eval { test_sv_catpvf($format); 1 };
+    my $exn = $got ? undef : $@;
+    like($exn, qr/\b\QCannot yet reorder sv_catpvfn() arguments from va_list\E\b/,
+         "explicit $what index forbidden in va_list arguments");
+}

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 71bf1ec..0c4f199 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -662,6 +662,14 @@ keep a reference count on its arguments and cannot be made to
 do so.  Such arrays are not even supposed to be accessible to
 Perl code, but are only used internally.
 
+=item Cannot yet reorder sv_catpvfn() arguments from va_list
+
+(F) Some XS code tried to use C<sv_catpvfn()> or a related function with a
+format string that specifies explicit indexes for some of the elements, and
+using a C-style variable-argument list (a C<va_list>). This is not currently
+supported. XS authors wanting to do this must instead construct a C array of
+C<SV*> scalars containing the arguments.
+
 =item Can only compress unsigned integers in pack
 
 (F) An argument to pack("w",...) was not an integer.  The BER compressed

diff --git a/sv.c b/sv.c
index e0f80d0..210150b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9193,7 +9193,7 @@ Perl_newSVpvf_nocontext(const char *const pat, ...)
 =for apidoc newSVpvf
 
 Creates a new SV and initializes it with the string formatted like
-C<sprintf>.
+C<sv_catpvf>.
 
 =cut
 */
@@ -10490,8 +10490,10 @@ Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
 /*
 =for apidoc sv_catpvf
 
-Processes its arguments like C<sprintf> and appends the formatted
-output to an SV.  If the appended data contains "wide" characters
+Processes its arguments like C<sv_catpvfn>, and appends the formatted
+output to an SV.  As with C<sv_catpvfn> called with a non-null C-style
+variable argument list, argument reordering is not supported.
+If the appended data contains "wide" characters
 (including, but not limited to, SVs with a UTF-8 PV formatted with %s,
 and characters >255 formatted with %c), the original SV might get
 upgraded to UTF-8.  Handles 'get' magic, but not 'set' magic.  See
@@ -10515,7 +10517,8 @@ Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...)
 /*
 =for apidoc sv_vcatpvf
 
-Processes its arguments like C<vsprintf> and appends the formatted output
+Processes its arguments like C<sv_catpvfn> called with a non-null C-style
+variable argument list, and appends the formatted
 to an SV.  Does not handle 'set' magic.  See C<sv_vcatpvf_mg>.
 
 Usually used via its frontend C<sv_catpvf>.
@@ -10669,8 +10672,13 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
 =for apidoc sv_vcatpvfn_flags
 
 Processes its arguments like C<vsprintf> and appends the formatted output
-to an SV.  Uses an array of SVs if the C style variable argument list is
-missing (NULL).  When running with taint checks enabled, indicates via
+to an SV.  Uses an array of SVs if the C-style variable argument list is
+missing (NULL). Argument reordering (using format specifiers like C<%2$d>
+or C<%*2$d>) is supported only when using an array of SVs; using a C-style
+C<va_list> argument list with a format string that uses argument reordering
+will yield an exception.
+
+When running with taint checks enabled, indicates via
 C<maybe_tainted> if results are untrustworthy (often due to the use of
 locales).
 
@@ -11337,6 +11345,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
        if ( (width = expect_number(&q)) ) {
            if (*q == '$') {
+                if (args)
+                    Perl_croak_nocontext(
+                        "Cannot yet reorder sv_catpvfn() arguments from va_list");
                ++q;
                efix = width;
                 used_explicit_ix = TRUE;
@@ -11381,9 +11392,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        if (*q == '*') {
            q++;
            if ( (ewix = expect_number(&q)) ) {
-               if (*q++ == '$')
+               if (*q++ == '$') {
+                    if (args)
+                        Perl_croak_nocontext(
+                            "Cannot yet reorder sv_catpvfn() arguments from va_list");
                     used_explicit_ix = TRUE;
-                else
+                } else
                    goto unknown;
             }
            asterisk = TRUE;
@@ -11450,9 +11464,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            if (*q == '*') {
                q++;
                 if ( (epix = expect_number(&q)) ) {
-                    if (*q++ == '$')
+                    if (*q++ == '$') {
+                        if (args)
+                            Perl_croak_nocontext(
+                                "Cannot yet reorder sv_catpvfn() arguments from va_list");
                         used_explicit_ix = TRUE;
-                    else
+                    } else
                         goto unknown;
                 }
                if (args)