diff options
author | Aaron Crane <arc@cpan.org> | 2015-07-07 18:16:36 +0100 |
---|---|---|
committer | Aaron Crane <arc@cpan.org> | 2015-07-15 14:26:06 +0100 |
commit | 46e58bd2391172ab5e4a73c29fb3313bebcf00bc (patch) | |
tree | 73a9c44d058a2d156c312fd951cfaf5b10569e27 | |
parent | 638ca15aeec3bf86124489c8c913c5b42d4fee16 (diff) | |
download | perl-46e58bd2391172ab5e4a73c29fb3313bebcf00bc.tar.gz |
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.
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | ext/XS-APItest/APItest.pm | 2 | ||||
-rw-r--r-- | ext/XS-APItest/APItest.xs | 10 | ||||
-rw-r--r-- | ext/XS-APItest/t/svcatpvf.t | 21 | ||||
-rw-r--r-- | pod/perldiag.pod | 8 | ||||
-rw-r--r-- | sv.c | 37 |
6 files changed, 68 insertions, 11 deletions
@@ -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 28d6beca27..93b3cb61d5 100644 --- 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 aef057238e..7a258deb25 100644 --- 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 index 0000000000..15348891bf --- /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 71bf1ec87a..0c4f19961b 100644 --- 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 @@ -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) |