summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAaron Crane <arc@cpan.org>2015-07-07 18:16:36 +0100
committerAaron Crane <arc@cpan.org>2015-07-15 14:26:06 +0100
commit46e58bd2391172ab5e4a73c29fb3313bebcf00bc (patch)
tree73a9c44d058a2d156c312fd951cfaf5b10569e27
parent638ca15aeec3bf86124489c8c913c5b42d4fee16 (diff)
downloadperl-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--MANIFEST1
-rw-r--r--ext/XS-APItest/APItest.pm2
-rw-r--r--ext/XS-APItest/APItest.xs10
-rw-r--r--ext/XS-APItest/t/svcatpvf.t21
-rw-r--r--pod/perldiag.pod8
-rw-r--r--sv.c37
6 files changed, 68 insertions, 11 deletions
diff --git a/MANIFEST b/MANIFEST
index bfdabac35d..61437ba7eb 100644
--- 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 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
diff --git a/sv.c b/sv.c
index e0f80d036a..210150b23d 100644
--- 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)