Fix %vd with alpha version

There are five problems with it:

First, this warning is not suppressible, even with -X:

$ perl -Xe' sprintf "[%vd]\n", new version v1.1_1'
vector argument not supported with alpha versions at -e line 1.

To keep the behaviour as close as possible to what it was already
without the incorrect behaviour, I have made it a default warning.

Secondly, putting it in the internal category does not make sense.
internal is a subset of severe, and contains warnings that indicate
internal inconsistencies, like ‘Scalars leaked’ and ‘Unbalanced string
table refcount’.  It should be in the printf warnings category.

Thirdly, if we turn warnings on explicitly, we see this:

$ perl -we '() = sprintf "[%vd]\n", new version v1.1_1'
vector argument not supported with alpha versions at -e line 1.
Invalid conversion in printf: "%v" at -e line 1.

%vd is not invalid.  That warning is bogus.

Fourthly, %vd itself gets output when fed an alpha version:

$ perl -Xe 'printf "[%vd]\n", new version v1.1_1'
vector argument not supported with alpha versions at -e line 1.
[%vd]

If an argument is missing or invalid or what have you, the %-format
itself should not be output.  An empty string makes the most sense.

Fifthly, it leaks memory.  Run this and watch memory usage go up:

$ perl -e '
   warn $$; $SIG{__WARN__} = sub {}; $v = new version v1.1_1;
   sprintf "%vd", $v while 1
'

It does savesvpv before shortcircuiting for alphas.  But the corres-
ponding Safefree comes after the shortcircuiting, which skips it.

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 0b7a523..a916dea 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -5695,7 +5695,7 @@ are automatically rebound to the current values of such variables.
 
 =item vector argument not supported with alpha versions
 
-(W internal) The %vd (s)printf format does not support version objects
+(S printf) The %vd (s)printf format does not support version objects
 with alpha parts.
 
 =item Verb pattern '%s' has a mandatory argument in regex; marked by <-- HERE in m/%s/ 

diff --git a/sv.c b/sv.c
index b47dc75..61c67b0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10375,12 +10375,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 * vectorize happen normally
                 */
                if (sv_isobject(vecsv) && sv_derived_from(vecsv, "version")) {
-                   char *version = savesvpv(vecsv);
+                   char *version;
                    if ( hv_exists(MUTABLE_HV(SvRV(vecsv)), "alpha", 5 ) ) {
-                       Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+                       Perl_ck_warner_d(aTHX_ packWARN(WARN_PRINTF),
                        "vector argument not supported with alpha versions");
-                       goto unknown;
+                       goto vdblank;
                    }
+                   version = savesvpv(vecsv);
                    vecsv = sv_newmortal();
                    scan_vstring(version, version + veclen, vecsv);
                    vecstr = (U8*)SvPV_const(vecsv, veclen);
@@ -10389,6 +10390,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                }
            }
            else {
+             vdblank:
                vecstr = (U8*)"";
                veclen = 0;
            }

diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv
index d6cacd8..41a4fab 100644 (file)
--- a/t/lib/warnings/sv
+++ b/t/lib/warnings/sv
@@ -34,6 +34,8 @@
 
   Reference is already weak                    [Perl_sv_rvweaken] <<TODO
 
+  vector argument not supported with alpha versions
+
   Mandatory Warnings
   ------------------
   Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
@@ -385,3 +387,13 @@ sub 짐 {}
 *짐 = \&조Ȩ ;
 EXPECT
 Subroutine main::ｆ렏 redefined at - line 7.
+########
+# sv.c
+sprintf "%vd", new version v1.1_0;
+use warnings 'printf' ;
+sprintf "%vd", new version v1.1_0;
+no warnings 'printf' ;
+sprintf "%vd", new version v1.1_0;
+EXPECT
+vector argument not supported with alpha versions at - line 2.
+vector argument not supported with alpha versions at - line 4.

diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 34086c8..a04abf5 100644 (file)
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -62,6 +62,8 @@ $SIG{__WARN__} = sub {
        $w .= ' UNINIT';
     } elsif ($_[0] =~ /^Missing argument/) {
        $w .= ' MISSING';
+    } elsif ($_[0]=~/^vector argument not supported with alpha versions/) {
+       $w .= ' ALPHA';
     } else {
        warn @_;
     }
@@ -317,6 +319,7 @@ __END__
 >%vd<       >[version->new("1.002")]< >1.2<
 >%vd<       >[version->new("1048576.5")]< >1048576.5<
 >%vd<       >[version->new("50")]< >50<
+>[%vd]<     >[version->new(v1.1_1)]< >[] ALPHA<
 >%v.3d<     >"\01\02\03"< >001.002.003<
 >%0v3d<     >"\01\02\03"< >001.002.003<
 >%v.3d<     >[version::qv("1.2.3")]< >001.002.003<