summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist/IO/t/IO.t1
-rw-r--r--lib/warnings.pm12
-rw-r--r--regen/warnings.pl22
-rw-r--r--t/lib/warnings/2use19
-rw-r--r--t/lib/warnings/regcomp2
-rw-r--r--t/lib/warnings/toke2
-rw-r--r--t/op/universal.t1
-rw-r--r--t/uni/universal.t1
8 files changed, 47 insertions, 13 deletions
diff --git a/dist/IO/t/IO.t b/dist/IO/t/IO.t
index 382e282a07..2551b2468d 100644
--- a/dist/IO/t/IO.t
+++ b/dist/IO/t/IO.t
@@ -49,6 +49,7 @@ local $SIG{__WARN__} = sub { $warn = "@_" } ;
{
local $^W = 0;
+ no if $^V >= 5.17.4, warnings => "deprecated";
IO->import();
is( $warn, '', "... import default, should not warn");
$warn = '' ;
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 3b2d87dc82..934bdd49f5 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -336,6 +336,7 @@ our %DeadBits = (
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0";
+$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00", # [2,4,22,23,25]
$LAST_BIT = 102 ;
$BYTES = 13 ;
@@ -387,7 +388,7 @@ sub import
{
shift;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
@@ -403,7 +404,7 @@ sub unimport
shift;
my $catmask ;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
@@ -482,8 +483,11 @@ sub __chk
$i = _error_loc(); # see where Carp will allocate the error
}
- # Defaulting this to 0 reduces complexity in code paths below.
- my $callers_bitmask = (caller($i))[9] || 0 ;
+ # Default to 0 if caller returns nothing. Default to $DEFAULT if it
+ # explicitly returns undef.
+ my(@callers_bitmask) = (caller($i))[9] ;
+ my $callers_bitmask =
+ @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
my @results;
foreach my $type (FATAL, NORMAL) {
diff --git a/regen/warnings.pl b/regen/warnings.pl
index d990a6c8a5..70a35d3c41 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -53,11 +53,11 @@ my $tree = {
}],
'severe' => [ 5.008, {
'inplace' => [ 5.008, DEFAULT_ON],
- 'internal' => [ 5.008, DEFAULT_ON],
+ 'internal' => [ 5.008, DEFAULT_OFF],
'debugging' => [ 5.008, DEFAULT_ON],
'malloc' => [ 5.008, DEFAULT_ON],
}],
- 'deprecated' => [ 5.008, DEFAULT_OFF],
+ 'deprecated' => [ 5.008, DEFAULT_ON],
'void' => [ 5.008, DEFAULT_OFF],
'recursion' => [ 5.008, DEFAULT_OFF],
'redefine' => [ 5.008, DEFAULT_OFF],
@@ -66,7 +66,7 @@ my $tree = {
'once' => [ 5.008, DEFAULT_OFF],
'misc' => [ 5.008, DEFAULT_OFF],
'regexp' => [ 5.008, DEFAULT_OFF],
- 'glob' => [ 5.008, DEFAULT_OFF],
+ 'glob' => [ 5.008, DEFAULT_ON],
'untie' => [ 5.008, DEFAULT_OFF],
'substr' => [ 5.008, DEFAULT_OFF],
'taint' => [ 5.008, DEFAULT_OFF],
@@ -89,6 +89,7 @@ my $tree = {
}],
} ;
+my @def ;
my %list ;
my %Value ;
my %ValueToName ;
@@ -151,6 +152,8 @@ sub walk
my ($ver, $rest) = @{ $v } ;
if (ref $rest)
{ push (@{ $list{$k} }, walk ($rest)) }
+ elsif ($rest == DEFAULT_ON)
+ { push @def, $NameToValue{uc $k} }
push @list, @{ $list{$k} } ;
}
@@ -416,6 +419,8 @@ foreach $k (sort keys %list) {
print $pm " );\n\n" ;
print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
+print $pm '$DEFAULT = "', mkHex($warn_size, map $_ * 2, @def),
+ '", # [', mkRange(@def), "]\n" ;
print $pm '$LAST_BIT = ' . "$index ;\n" ;
print $pm '$BYTES = ' . "$warn_size ;\n" ;
while (<DATA>) {
@@ -636,7 +641,7 @@ sub import
{
shift;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
@@ -652,7 +657,7 @@ sub unimport
shift;
my $catmask ;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
@@ -731,8 +736,11 @@ sub __chk
$i = _error_loc(); # see where Carp will allocate the error
}
- # Defaulting this to 0 reduces complexity in code paths below.
- my $callers_bitmask = (caller($i))[9] || 0 ;
+ # Default to 0 if caller returns nothing. Default to $DEFAULT if it
+ # explicitly returns undef.
+ my(@callers_bitmask) = (caller($i))[9] ;
+ my $callers_bitmask =
+ @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
my @results;
foreach my $type (FATAL, NORMAL) {
diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use
index e5a8103b81..c0d203a399 100644
--- a/t/lib/warnings/2use
+++ b/t/lib/warnings/2use
@@ -358,3 +358,22 @@ $a =+ 1 ;
EXPECT
Reversed += operator at - line 6.
Use of uninitialized value $c in scalar chop at - line 9.
+########
+
+# Check that deprecation warnings are not implicitly disabled by use
+$*;
+use warnings "void";
+$#;
+EXPECT
+$* is no longer supported at - line 3.
+$# is no longer supported at - line 5.
+Useless use of a variable in void context at - line 5.
+########
+
+# Check that deprecation warnings are not implicitly disabled by no
+$*;
+no warnings "void";
+$#;
+EXPECT
+$* is no longer supported at - line 3.
+$# is no longer supported at - line 5.
diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp
index a329639bbe..15a658fb9b 100644
--- a/t/lib/warnings/regcomp
+++ b/t/lib/warnings/regcomp
@@ -54,7 +54,7 @@ Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <--
########
# regcomp.c [S_regatom]
# The \q should warn, the \_ should NOT warn.
-use warnings 'regexp';
+use warnings 'regexp'; no warnings "deprecated";
"foo" =~ /\q/;
"foo" =~ /\q{/;
"foo" =~ /\w{/;
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index e436ceca9a..8a8fb052da 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1085,7 +1085,7 @@ Number found where operator expected at (eval 1) line 1, near "5 6"
(Missing operator before 6?)
########
# toke.c
-use warnings "syntax";
+use warnings "syntax"; no warnings "deprecated";
$_ = $a = 1;
$a !=~ /1/;
$a !=~ m#1#;
diff --git a/t/op/universal.t b/t/op/universal.t
index bbee79ecf6..9db10c8e35 100644
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -175,6 +175,7 @@ ok ! UNIVERSAL::isa("\xff\xff\xff\0", 'HASH');
{
package Pickup;
+ no warnings "deprecated";
use UNIVERSAL qw( isa can VERSION );
::ok isa "Pickup", UNIVERSAL;
diff --git a/t/uni/universal.t b/t/uni/universal.t
index 8f158e90b8..626c30f857 100644
--- a/t/uni/universal.t
+++ b/t/uni/universal.t
@@ -119,6 +119,7 @@ ok $a->can("slèèp");
{
package Pìckùp;
+ no warnings "deprecated";
use UNIVERSAL qw( isa can VERSION );
::ok isa "Pìckùp", UNIVERSAL;
View Lorry Controller Status