|
 |
2bfd83c |
From 55b6481ff87f84626ba01275708297a42a6537b1 Mon Sep 17 00:00:00 2001
|
|
|
2bfd83c |
From: David Mitchell <davem@iabyn.com>
|
|
|
2bfd83c |
Date: Tue, 21 Jun 2016 15:23:20 +0100
|
|
|
2bfd83c |
Subject: [PATCH] uninit warning from $h{\const} coredumped
|
|
|
2bfd83c |
MIME-Version: 1.0
|
|
|
2bfd83c |
Content-Type: text/plain; charset=UTF-8
|
|
|
2bfd83c |
Content-Transfer-Encoding: 8bit
|
|
|
2bfd83c |
|
|
|
2bfd83c |
The code that printed the the name and subscript of a hash element
|
|
|
2bfd83c |
in an "uninitialized variable" warning assumed that a constant
|
|
|
2bfd83c |
hash subscript would be SvPOK. Something like \1 is a constant,
|
|
|
2bfd83c |
but is ROK, not POK. SEGVs ensured.
|
|
|
2bfd83c |
|
|
|
2bfd83c |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
2bfd83c |
---
|
|
|
2bfd83c |
sv.c | 5 ++++-
|
|
|
2bfd83c |
t/op/hashwarn.t | 19 ++++++++++++++++++-
|
|
|
2bfd83c |
2 files changed, 22 insertions(+), 2 deletions(-)
|
|
|
2bfd83c |
|
|
|
2bfd83c |
diff --git a/sv.c b/sv.c
|
|
|
2bfd83c |
index 535ee8d..b0fdd15 100644
|
|
|
2bfd83c |
--- a/sv.c
|
|
|
2bfd83c |
+++ b/sv.c
|
|
|
2bfd83c |
@@ -15683,9 +15683,12 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
|
|
|
2bfd83c |
|
|
|
2bfd83c |
if (subscript_type == FUV_SUBSCRIPT_HASH) {
|
|
|
2bfd83c |
SV * const sv = newSV(0);
|
|
|
2bfd83c |
+ STRLEN len;
|
|
|
2bfd83c |
+ const char * const pv = SvPV_nomg_const((SV*)keyname, len);
|
|
|
2bfd83c |
+
|
|
|
2bfd83c |
*SvPVX(name) = '$';
|
|
|
2bfd83c |
Perl_sv_catpvf(aTHX_ name, "{%s}",
|
|
|
2bfd83c |
- pv_pretty(sv, SvPVX_const(keyname), SvCUR(keyname), 32, NULL, NULL,
|
|
|
2bfd83c |
+ pv_pretty(sv, pv, len, 32, NULL, NULL,
|
|
|
2bfd83c |
PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_UNI_DETECT ));
|
|
|
2bfd83c |
SvREFCNT_dec_NN(sv);
|
|
|
2bfd83c |
}
|
|
|
2bfd83c |
diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t
|
|
|
2bfd83c |
index a6a1de9..6d72244 100644
|
|
|
2bfd83c |
--- a/t/op/hashwarn.t
|
|
|
2bfd83c |
+++ b/t/op/hashwarn.t
|
|
|
2bfd83c |
@@ -6,7 +6,7 @@ BEGIN {
|
|
|
2bfd83c |
}
|
|
|
2bfd83c |
|
|
|
2bfd83c |
require './test.pl';
|
|
|
2bfd83c |
-plan( tests => 16 );
|
|
|
2bfd83c |
+plan( tests => 18 );
|
|
|
2bfd83c |
|
|
|
2bfd83c |
use strict;
|
|
|
2bfd83c |
use warnings;
|
|
|
2bfd83c |
@@ -71,3 +71,20 @@ my $fail_not_hr = 'Not a HASH reference at ';
|
|
|
2bfd83c |
cmp_ok(scalar(@warnings),'==',0,'pseudo-hash 2 count');
|
|
|
2bfd83c |
cmp_ok(substr($@,0,length($fail_not_hr)),'eq',$fail_not_hr,'pseudo-hash 2 msg');
|
|
|
2bfd83c |
}
|
|
|
2bfd83c |
+
|
|
|
2bfd83c |
+# RT #128189
|
|
|
2bfd83c |
+# this used to coredump
|
|
|
2bfd83c |
+
|
|
|
2bfd83c |
+{
|
|
|
2bfd83c |
+ @warnings = ();
|
|
|
2bfd83c |
+ my %h;
|
|
|
2bfd83c |
+
|
|
|
2bfd83c |
+ no warnings;
|
|
|
2bfd83c |
+ use warnings qw(uninitialized);
|
|
|
2bfd83c |
+
|
|
|
2bfd83c |
+ my $x = "$h{\1}";
|
|
|
2bfd83c |
+ is(scalar @warnings, 1, "RT #128189 - 1 warning");
|
|
|
2bfd83c |
+ like("@warnings",
|
|
|
2bfd83c |
+ qr/Use of uninitialized value \$h\{"SCALAR\(0x[\da-f]+\)"\}/,
|
|
|
2bfd83c |
+ "RT #128189 correct warning");
|
|
|
2bfd83c |
+}
|
|
|
2bfd83c |
--
|
|
|
2bfd83c |
2.5.5
|
|
|
2bfd83c |
|