This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
move the SETJMP exception-handing definitions from scope.h to cop.h
[perl5.git]
/
warnings.pl
diff --git
a/warnings.pl
b/warnings.pl
index
586e5a7
..
e7659b9
100644
(file)
--- a/
warnings.pl
+++ b/
warnings.pl
@@
-1,7
+1,6
@@
#!/usr/bin/perl
#!/usr/bin/perl
-
-$VERSION = '1.00';
+$VERSION = '1.02';
BEGIN {
push @INC, './lib';
BEGIN {
push @INC, './lib';
@@
-50,7
+49,6
@@
my $tree = {
'misc' => [ 5.008, DEFAULT_OFF],
'regexp' => [ 5.008, DEFAULT_OFF],
'glob' => [ 5.008, DEFAULT_OFF],
'misc' => [ 5.008, DEFAULT_OFF],
'regexp' => [ 5.008, DEFAULT_OFF],
'glob' => [ 5.008, DEFAULT_OFF],
- 'y2k' => [ 5.008, DEFAULT_OFF],
'untie' => [ 5.008, DEFAULT_OFF],
'substr' => [ 5.008, DEFAULT_OFF],
'taint' => [ 5.008, DEFAULT_OFF],
'untie' => [ 5.008, DEFAULT_OFF],
'substr' => [ 5.008, DEFAULT_OFF],
'taint' => [ 5.008, DEFAULT_OFF],
@@
-63,6
+61,8
@@
my $tree = {
'pack' => [ 5.008, DEFAULT_OFF],
'unpack' => [ 5.008, DEFAULT_OFF],
'threads' => [ 5.008, DEFAULT_OFF],
'pack' => [ 5.008, DEFAULT_OFF],
'unpack' => [ 5.008, DEFAULT_OFF],
'threads' => [ 5.008, DEFAULT_OFF],
+ 'assertions' => [ 5.009, DEFAULT_OFF],
+
#'default' => [ 5.008, DEFAULT_ON ],
}],
} ;
#'default' => [ 5.008, DEFAULT_ON ],
}],
} ;
@@
-252,7
+252,9
@@
if (@ARGV && $ARGV[0] eq "tree")
unlink "warnings.h";
unlink "lib/warnings.pm";
open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
unlink "warnings.h";
unlink "lib/warnings.pm";
open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+binmode WARN;
open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
+binmode PM;
print WARN <<'EOM' ;
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
print WARN <<'EOM' ;
/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
@@
-413,7
+415,7
@@
while (<DATA>) {
#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
$last_ver = 0;
#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
$last_ver = 0;
-print PM "%Offsets = (\n" ;
+print PM "
our
%Offsets = (\n" ;
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
$name = lc $name;
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
$name = lc $name;
@@
-429,7
+431,7
@@
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
print PM " );\n\n" ;
print PM " );\n\n" ;
-print PM "%Bits = (\n" ;
+print PM "
our
%Bits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
@@
-443,7
+445,7
@@
foreach $k (sort keys %list) {
print PM " );\n\n" ;
print PM " );\n\n" ;
-print PM "%DeadBits = (\n" ;
+print PM "
our
%DeadBits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
@@
-474,7
+476,7
@@
__END__
package warnings;
package warnings;
-our $VERSION = '1.0
0
';
+our $VERSION = '1.0
4
';
=head1 NAME
=head1 NAME
@@
-507,6
+509,10
@@
warnings - Perl pragma to control optional warnings
=head1 DESCRIPTION
=head1 DESCRIPTION
+The C<warnings> pragma is a replacement for the command line flag C<-w>,
+but the pragma is limited to the enclosing block, while the flag is global.
+See L<perllexwarn> for more information.
+
If no import list is supplied, all possible warnings are either enabled
or disabled.
If no import list is supplied, all possible warnings are either enabled
or disabled.
@@
-595,16
+601,15
@@
See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
=cut
=cut
-use Carp ;
-
KEYWORDS
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
sub Croaker
{
KEYWORDS
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
sub Croaker
{
+ require Carp;
delete $Carp::CarpInternal{'warnings'};
delete $Carp::CarpInternal{'warnings'};
-
croak @_
;
+
Carp::croak(@_)
;
}
sub bits
}
sub bits
@@
-705,6
+710,8
@@
sub unimport
${^WARNING_BITS} = $mask ;
}
${^WARNING_BITS} = $mask ;
}
+my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
+
sub __chk
{
my $category ;
sub __chk
{
my $category ;
@@
-714,10
+721,10
@@
sub __chk
if (@_) {
# check the category supplied.
$category = shift ;
if (@_) {
# check the category supplied.
$category = shift ;
- if (ref $category) {
- Croaker
("not an object")
- if
$category !~ /^([^=]+)=/
;
- $category = $
1
;
+ if (
my $type =
ref $category) {
+ Croaker("not an object")
+ if
exists $builtin_type{$type}
;
+ $category = $
type
;
$isobj = 1 ;
}
$offset = $Offsets{$category};
$isobj = 1 ;
}
$offset = $Offsets{$category};
@@
-742,17
+749,18
@@
sub __chk
$i -= 2 ;
}
else {
$i -= 2 ;
}
else {
- for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
- last if $pkg ne $this_pkg ;
- }
- $i = 2
- if !$pkg || $pkg eq $this_pkg ;
+ $i = _error_loc(); # see where Carp will allocate the error
}
my $callers_bitmask = (caller($i))[9] ;
return ($callers_bitmask, $offset, $i) ;
}
}
my $callers_bitmask = (caller($i))[9] ;
return ($callers_bitmask, $offset, $i) ;
}
+sub _error_loc {
+ require Carp::Heavy;
+ goto &Carp::short_error_loc; # don't introduce another stack frame
+}
+
sub enabled
{
Croaker("Usage: warnings::enabled([category])")
sub enabled
{
Croaker("Usage: warnings::enabled([category])")
@@
-773,10
+781,11
@@
sub warn
my $message = pop ;
my ($callers_bitmask, $offset, $i) = __chk(@_) ;
my $message = pop ;
my ($callers_bitmask, $offset, $i) = __chk(@_) ;
- croak($message)
+ require Carp;
+ Carp::croak($message)
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
- carp($message) ;
+
Carp::
carp($message) ;
}
sub warnif
}
sub warnif
@@
-792,11
+801,12
@@
sub warnif
(vec($callers_bitmask, $offset, 1) ||
vec($callers_bitmask, $Offsets{'all'}, 1)) ;
(vec($callers_bitmask, $offset, 1) ||
vec($callers_bitmask, $Offsets{'all'}, 1)) ;
- croak($message)
+ require Carp;
+ Carp::croak($message)
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
- carp($message) ;
+
Carp::
carp($message) ;
}
1;
}
1;