summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-11-21 13:02:47 -0800
committerFather Chrysostomos <sprout@cpan.org>2011-11-21 13:02:47 -0800
commitefcf35c4ce9be7ae046664523cf99dac85257e4a (patch)
tree18f909afe9e245232f87255669fc76a8314c9af7
parentf965e9d4a373e14022c83f58715a948ea40a9b4a (diff)
downloadperl-efcf35c4ce9be7ae046664523cf99dac85257e4a.tar.gz
Make constant sub redef warnings obey scope
In perldiag, this is listed as (S), which means that outside of any use/no warnings scope it always warns, regardless of $^W. But this warning was ignoring use/no warnings, too. There were actually tests for this oddity, but I think those were added by mistake, or this was just not thought through. I cannot see how this is not a bug.
-rw-r--r--op.c1
-rw-r--r--sv.c1
-rw-r--r--t/lib/warnings/op26
3 files changed, 18 insertions, 10 deletions
diff --git a/op.c b/op.c
index 97407ad81a..257e2214d3 100644
--- a/op.c
+++ b/op.c
@@ -6592,6 +6592,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
strEQ(hvname, "autouse"))
))
|| (CvCONST(cv)
+ && ckWARN_d(WARN_REDEFINE)
&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
{
const line_t oldline = CopLINE(PL_curcop);
diff --git a/sv.c b/sv.c
index 0095e072e7..d4f0373b21 100644
--- a/sv.c
+++ b/sv.c
@@ -3833,6 +3833,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
)
)
|| (CvCONST(cv)
+ && ckWARN_d(WARN_REDEFINE)
&& (!CvCONST((const CV *)sref)
|| sv_cmp(cv_const_sv(cv),
cv_const_sv((const CV *)
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 1a1bb26b7f..6c1f1f1a6f 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -732,18 +732,28 @@ EXPECT
Constant subroutine fred redefined at - line 4.
########
# op.c
+sub fred () { 1 }
+sub fred () { 2 }
+EXPECT
+Constant subroutine fred redefined at - line 3.
+########
+# op.c
+sub fred () { 1 }
+*fred = sub () { 2 };
+EXPECT
+Constant subroutine main::fred redefined at - line 3.
+########
+# op.c
no warnings 'redefine' ;
sub fred () { 1 }
sub fred () { 2 }
EXPECT
-Constant subroutine fred redefined at - line 4.
########
# op.c
no warnings 'redefine' ;
sub fred () { 1 }
*fred = sub () { 2 };
EXPECT
-Constant subroutine main::fred redefined at - line 4.
########
# op.c
use warnings 'redefine' ;
@@ -1240,22 +1250,20 @@ EXPECT
Constant subroutine frèd redefined at - line 6.
########
# op.c
-no warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub frèd () { 1 }
sub frèd () { 2 }
EXPECT
-Constant subroutine frèd redefined at - line 6.
+Constant subroutine frèd redefined at - line 5.
########
# op.c
-no warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub frèd () { 1 }
*frèd = sub () { 2 };
EXPECT
-Constant subroutine main::frèd redefined at - line 6.
+Constant subroutine main::frèd redefined at - line 5.
########
# op.c
use warnings 'redefine' ;
@@ -1280,20 +1288,18 @@ EXPECT
Constant subroutine ᚠርƊ redefined at - line 6.
########
# op.c
-no warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ () { 1 }
sub ᚠርƊ () { 2 }
EXPECT
-Constant subroutine ᚠርƊ redefined at - line 6.
+Constant subroutine ᚠርƊ redefined at - line 5.
########
# op.c
-no warnings 'redefine' ;
use utf8;
use open qw( :utf8 :std );
sub ᚠርƊ () { 1 }
*ᚠርƊ = sub () { 2 };
EXPECT
-Constant subroutine main::ᚠርƊ redefined at - line 6.
+Constant subroutine main::ᚠርƊ redefined at - line 5.
########