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