t/pragma/warn/6default Tests default warnings
t/pragma/warn/7fatal Tests fatal warnings
t/pragma/warn/8signal Tests warnings + __WARN__ and __DIE__
+t/pragma/warn/9enabled Tests warnings
t/pragma/warn/av Tests for av.c for warnings.t
t/pragma/warn/doio Tests for doio.c for warnings.t
t/pragma/warn/doop Tests for doop.c for warnings.t
use warnings "all";
no warnings "all";
+ if (warnings::enabled("void") {
+ warnings::warn("void", "some warning");
+ }
+
=head1 DESCRIPTION
If no import list is supplied, all possible warnings are either enabled
or disabled.
-See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
+Two functions are provided to assist module authors.
+
+=over 4
+
+=item warnings::enabled($category)
+
+Returns TRUE if the warnings category in C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
+
+
+=item warnings::warn($category, $message)
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
+
+=back
+
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
=cut
use Carp ;
%Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..35]
- 'ambiguous' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [16]
- 'bareword' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [17]
- 'closed' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'closure' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [27]
- 'debugging' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [12]
- 'deprecated' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18]
- 'digit' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [19]
- 'exec' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'inplace' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [13]
- 'internal' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [14]
- 'io' => "\x55\x05\x00\x00\x00\x00\x00\x00\x00", # [0..5]
- 'misc' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'newline' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'numeric' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'octal' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [20]
- 'once' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [8]
- 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [28]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21]
- 'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4]
- 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29]
- 'printf' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [22]
- 'recursion' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [9]
- 'redefine' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [10]
- 'reserved' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [23]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [24]
- 'severe' => "\x00\x00\x40\x15\x00\x00\x00\x00\x00", # [11..14]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [30]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [31]
- 'syntax' => "\x00\x00\x00\x40\x55\x55\x01\x00\x00", # [15..24]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [32]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [25]
- 'unopened' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'unsafe' => "\x00\x00\x00\x00\x00\x00\x50\x55\x15", # [26..34]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [33]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [34]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [35]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
+ 'chmod' => "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
+ 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
+ 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+ 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+ 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
+ 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
+ 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+ 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
+ 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+ 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+ 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+ 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
);
%DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..35]
- 'ambiguous' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [16]
- 'bareword' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [17]
- 'closed' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'closure' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [27]
- 'debugging' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [12]
- 'deprecated' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18]
- 'digit' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [19]
- 'exec' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'inplace' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [13]
- 'internal' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [14]
- 'io' => "\xaa\x0a\x00\x00\x00\x00\x00\x00\x00", # [0..5]
- 'misc' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'newline' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'numeric' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'octal' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [20]
- 'once' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [8]
- 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [28]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21]
- 'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4]
- 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29]
- 'printf' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [22]
- 'recursion' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [9]
- 'redefine' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [10]
- 'reserved' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [23]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [24]
- 'severe' => "\x00\x00\x80\x2a\x00\x00\x00\x00\x00", # [11..14]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [30]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [31]
- 'syntax' => "\x00\x00\x00\x80\xaa\xaa\x02\x00\x00", # [15..24]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [32]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [25]
- 'unopened' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'unsafe' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\x2a", # [26..34]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [33]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [34]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [35]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
+ 'chmod' => "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
+ 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
+ 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+ 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+ 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
+ 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
+ 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+ 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
+ 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+ 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+ 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+ 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
);
+$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
sub bits {
my $mask ;
sub enabled
{
- my $string = shift ;
-
+ # If no parameters, check for any lexical warnings enabled
+ # in the users scope.
+ my $callers_bitmask = (caller(1))[9] ;
+ return ($callers_bitmask ne $NONE) if @_ == 0 ;
+
+ # otherwise check for the category supplied.
+ my $category = shift ;
+ return 0
+ unless $Bits{$category} ;
+ return 0 unless defined $callers_bitmask ;
return 1
- if $bits{$string} && ${^WARNING_BITS} & $bits{$string} ;
+ if ($callers_bitmask & $Bits{$category}) ne $NONE ;
return 0 ;
}
+sub warn
+{
+ croak "Usage: warnings::warn('category', 'message')"
+ unless @_ == 2 ;
+ my $category = shift ;
+ my $message = shift ;
+ local $Carp::CarpLevel = 1 ;
+ my $callers_bitmask = (caller(1))[9] ;
+ croak($message)
+ if defined $callers_bitmask &&
+ ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+ carp($message) ;
+}
+
1;
} STMT_END
#endif
+#ifdef PERL_IMPLICIT_CONTEXT
+# define PERL_IS_ALIVE aTHX
+#else
+# define PERL_IS_ALIVE TRUE
+#endif
+
+
/*
* Layout of memory:
* ~~~~~~~~~~~~~~~~
if (!bad_free_warn)
return;
#ifdef RCHECK
+#ifdef PERL_CORE
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(WARN_MALLOC, "%s free() ignored",
+ ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+#else
warn("%s free() ignored",
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+#endif
+#else
+#ifdef PERL_CORE
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(WARN_MALLOC, "%s", "Bad free() ignored");
#else
warn("%s", "Bad free() ignored");
#endif
+#endif
return; /* sanity */
}
#ifdef RCHECK
if (!bad_free_warn)
return Nullch;
#ifdef RCHECK
+#ifdef PERL_CORE
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(WARN_MALLOC, "%srealloc() %signored",
+ (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
+ ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
+#else
warn("%srealloc() %signored",
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
+#endif
+#else
+#ifdef PERL_CORE
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(WARN_MALLOC, "%s", "Bad realloc() ignored");
#else
warn("%s", "Bad realloc() ignored");
#endif
+#endif
return Nullch; /* sanity */
}
else {
i = whichsig(s); /* ...no, a brick */
if (!i) {
- if (ckWARN(WARN_SIGNAL) || strEQ(s,"ALARM"))
+ if (ckWARN(WARN_SIGNAL))
Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
return 0;
}
}
yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
}
- if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
+ if (ckWARN(WARN_MISC) && AvFILLp(PL_comppad_name) >= 0) {
SV **svp = AvARRAY(PL_comppad_name);
HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
PADOFFSET top = AvFILLp(PL_comppad_name);
|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"\"%s\" variable %s masks earlier declaration in same %s",
(PL_in_my == KEY_our ? "our" : "my"),
name,
&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
&& strEQ(name, SvPVX(sv)))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"\"our\" variable %s redeclared", name);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
dTHR;
OP *o;
- if (ckWARN(WARN_UNSAFE) &&
+ if (ckWARN(WARN_MISC) &&
(left->op_type == OP_RV2AV ||
left->op_type == OP_RV2HV ||
left->op_type == OP_PADAV ||
const char *sample = ((left->op_type == OP_RV2AV ||
left->op_type == OP_PADAV)
? "@array" : "%hash");
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"Applying %s to %s will act on scalar(%s)",
desc, sample, sample);
}
}
if (first->op_type == OP_CONST) {
if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
- Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
+ Perl_warner(aTHX_ WARN_BAREWORD, "Bareword found in conditional");
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
*firstp = Nullop;
else
scalar(other);
}
- else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
+ else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
OP *k1 = ((UNOP*)first)->op_first;
OP *k2 = k1->op_sibling;
OPCODE warnop = 0;
if (warnop) {
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_MISC,
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
{
dTHR;
- if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_UNSAFE)) {
+ if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
SV* msg = sv_newmortal();
SV* name = Nullsv;
Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
else
sv_catpv(msg, "none");
- Perl_warner(aTHX_ WARN_UNSAFE, "%"SVf, msg);
+ Perl_warner(aTHX_ WARN_PROTOTYPE, "%"SVf, msg);
}
}
maximum a prototype before. */
if (SvTYPE(gv) > SVt_NULL) {
if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)
- && ckWARN_d(WARN_UNSAFE))
+ && ckWARN_d(WARN_PROTOTYPE))
{
- Perl_warner(aTHX_ WARN_UNSAFE, "Runaway prototype");
+ Perl_warner(aTHX_ WARN_PROTOTYPE, "Runaway prototype");
}
cv_ckproto((CV*)gv, NULL, ps);
}
goto withattrs;
if (const_sv = cv_const_sv(cv))
const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
- if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE)
- && !(CvGV(cv) && GvSTASH(CvGV(cv))
- && HvNAME(GvSTASH(CvGV(cv)))
- && strEQ(HvNAME(GvSTASH(CvGV(cv))),
- "autouse")))
+ if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE))
{
line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ if (ckWARN(WARN_DEPRECATED))
+ Perl_warner(aTHX_ WARN_DEPRECATED,
"Array @%s missing the @ in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
op_free(kid);
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
+ if (ckWARN(WARN_DEPRECATED))
+ Perl_warner(aTHX_ WARN_DEPRECATED,
"Hash %%%s missing the %% in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
op_free(kid);
GvAVn(gv);
}
}
- else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+ else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
GV *gv = cGVOPo_gv;
if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
/* XXX could check prototype here instead of just carping */
SV *sv = sv_newmortal();
gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_PROTOTYPE,
"%s() called too early to check prototype",
SvPV_nolen(sv));
}
(W) A warning (optional).
(D) A deprecation (optional).
- (S) A severe warning (mandatory).
+ (S) A severe warning (default).
(F) A fatal error (trappable).
(P) An internal error you should never see (trappable).
(X) A very fatal error (nontrappable).
(A) An alien error message (not generated by Perl).
-Optional warnings are enabled by using the B<-w> switch. Warnings may
-be captured by setting C<$SIG{__WARN__}> to a reference to a routine that
-will be called on each warning instead of printing it. See L<perlvar>.
+The majority of messages from the first three classifications above (W,
+D & S) can be controlled using the C<warnings> pragma.
+
+If a message can be controlled by the C<warnings> pragma, its warning
+category is included with the classification letter in the description
+below.
+
+Optional warnings are enabled by using the C<warnings> pragma or the B<-w>
+and B<-W> switches. Warnings may be captured by setting C<$SIG{__WARN__}>
+to a reference to a routine that will be called on each warning instead
+of printing it. See L<perlvar>.
+
+Default warnings are always enabled unless they are explicitly disabled
+with the C<warnings> pragma or the B<-X> switch.
Trappable errors may be trapped using the eval operator. See
L<perlfunc/eval>. In almost all cases, warnings may be selectively
=item "%s" variable %s masks earlier declaration in same %s
-(W) A "my" or "our" variable has been redeclared in the current scope or statement,
+(W misc) A "my" or "our" variable has been redeclared in the current scope or statement,
effectively eliminating all access to the previous instance. This is almost
always a typographical error. Note that the earlier variable will still exist
until the end of the scope or until all closure referents to it are
=item "our" variable %s redeclared
-(W) You seem to have already declared the same global once before in the
+(W misc) You seem to have already declared the same global once before in the
current lexical scope.
=item "use" not allowed in expression
=item /%s/: Unrecognized escape \\%c passed through
-(W) You used a backslash-character combination which is not recognized
+(W regexp) You used a backslash-character combination which is not recognized
by Perl. This combination appears in an interpolated variable or a
C<'>-delimited regular expression. The character was understood literally.
=item /%s/: Unrecognized escape \\%c in character class passed through
-(W) You used a backslash-character combination which is not recognized
+(W regexp) You used a backslash-character combination which is not recognized
by Perl inside character classes. The character was understood literally.
=item /%s/ should probably be written as "%s"
-(W) You have used a pattern where Perl expected to find a string,
+(W syntax) You have used a pattern where Perl expected to find a string,
as in the first argument to C<join>. Perl will treat the true
or false result of matching the pattern against $_ as the string,
which is probably not what you had in mind.
=item %s (...) interpreted as function
-(W) You've run afoul of the rule that says that any list operator followed
+(W syntax) You've run afoul of the rule that says that any list operator followed
by parentheses turns into a function, with all the list operators arguments
found inside the parentheses. See L<perlop/Terms and List Operators (Leftward)>.
=item %s() called too early to check prototype
-(W) You've called a function that has a prototype before the parser saw a
+(W prototype) You've called a function that has a prototype before the parser saw a
definition or declaration for it, and Perl could not check that the call
conforms to the prototype. You need to either add an early prototype
declaration for the subroutine in question, or move the subroutine
=item %s matches null string many times
-(W) The pattern you've specified would be an infinite loop if the
+(W regexp) The pattern you've specified would be an infinite loop if the
regular expression engine didn't specifically check for that. See L<perlre>.
=item %s never introduced
-(S) The symbol in question was declared but somehow went out of scope
+(S internal) The symbol in question was declared but somehow went out of scope
before it could possibly have been used.
=item %s package attribute may clash with future reserved word: %s
-(W) A lowercase attribute name was used that had a package-specific handler.
+(W reserved) A lowercase attribute name was used that had a package-specific handler.
That name might have a meaning to Perl itself some day, even though it
doesn't yet. Perhaps you should use a mixed-case attribute name, instead.
See L<attributes>.
=item (in cleanup) %s
-(W) This prefix usually indicates that a DESTROY() method raised
+(W misc) This prefix usually indicates that a DESTROY() method raised
the indicated exception. Since destructors are usually called by
the system at arbitrary points during execution, and often a vast
number of times, the warning is issued only once for any number
=item accept() on closed socket %s
-(W) You tried to do an accept on a closed socket. Did you forget to check
+(W closed) You tried to do an accept on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/accept>.
=item Allocation too large: %lx
=item Applying %s to %s will act on scalar(%s)
-(W) The pattern match (//), substitution (s///), and transliteration (tr///)
+(W misc) The pattern match (//), substitution (s///), and transliteration (tr///)
operators work on scalar values. If you apply one of them to an array
or a hash, it will convert the array or hash to a scalar value -- the
length of an array, or the population info of a hash -- and then work on
=item Ambiguous use of %s resolved as %s
-(W)(S) You said something that may not be interpreted the way
+(W ambiguous)(S) You said something that may not be interpreted the way
you thought. Normally it's pretty easy to disambiguate it by supplying
a missing quote, operator, parenthesis pair or declaration.
=item Ambiguous call resolved as CORE::%s(), qualify as such or use &
-(W) A subroutine you have declared has the same name as a Perl keyword,
+(W ambiguous) A subroutine you have declared has the same name as a Perl keyword,
and you have used the name without qualification for calling one or the
other. Perl decided to call the builtin because the subroutine is
not imported.
=item Argument "%s" isn't numeric%s
-(W) The indicated string was fed as an argument to an operator that
+(W numeric) The indicated string was fed as an argument to an operator that
expected a numeric value instead. If you're fortunate the message
will identify which operator was so unfortunate.
=item Array @%s missing the @ in argument %d of %s()
-(D) Really old Perl let you omit the @ on array names in some spots. This
+(D deprecated) Really old Perl let you omit the @ on array names in some spots. This
is now heavily deprecated.
=item assertion botched: %s
=item Attempt to free non-arena SV: 0x%lx
-(P) All SV objects are supposed to be allocated from arenas that will
+(P internal) All SV objects are supposed to be allocated from arenas that will
be garbage collected on exit. An SV was discovered to be outside any
of those arenas.
=item Attempt to free nonexistent shared string
-(P) Perl maintains a reference counted internal table of strings to
+(P internal) Perl maintains a reference counted internal table of strings to
optimize the storage and access of hash keys and other strings. This
indicates someone tried to decrement the reference count of a string
that can no longer be found in the table.
=item Attempt to free temp prematurely
-(W) Mortalized values are supposed to be freed by the free_tmps()
+(W debugging) Mortalized values are supposed to be freed by the free_tmps()
routine. This indicates that something else is freeing the SV before
the free_tmps() routine gets a chance, which means that the free_tmps()
routine will be freeing an unreferenced scalar when it does try to free
=item Attempt to free unreferenced glob pointers
-(P) The reference counts got screwed up on symbol aliases.
+(P internal) The reference counts got screwed up on symbol aliases.
=item Attempt to free unreferenced scalar
-(W) Perl went to decrement the reference count of a scalar to see if it
+(W internal) Perl went to decrement the reference count of a scalar to see if it
would go to 0, and discovered that it had already gone to 0 earlier,
and should have been freed, and in fact, probably was freed. This
could indicate that SvREFCNT_dec() was called too many times, or that
=item Attempt to pack pointer to temporary value
-(W) You tried to pass a temporary value (like the result of a
+(W pack) You tried to pass a temporary value (like the result of a
function, or a computed expression) to the "p" pack() template. This
means the result contains a pointer to a location that could become
invalid anytime, even before the end of the current statement. Use
=item Attempt to use reference as lvalue in substr
-(W) You supplied a reference as the first argument to substr() used
+(W substr) You supplied a reference as the first argument to substr() used
as an lvalue, which is pretty strange. Perhaps you forgot to
dereference it first. See L<perlfunc/substr>.
=item Bad free() ignored
-(S) An internal routine called free() on something that had never been
+(S malloc) An internal routine called free() on something that had never been
malloc()ed in the first place. Mandatory, but can be disabled by
setting environment variable C<PERL_BADFREE> to 1.
=item Bad realloc() ignored
-(S) An internal routine called realloc() on something that had never been
+(S malloc) An internal routine called realloc() on something that had never been
malloc()ed in the first place. Mandatory, but can be disabled by
setting environment variable C<PERL_BADFREE> to 1.
=item Bareword "%s" refers to nonexistent package
-(W) You used a qualified bareword of the form C<Foo::>, but
+(W bareword) You used a qualified bareword of the form C<Foo::>, but
the compiler saw no other uses of that namespace before that point.
Perhaps you need to predeclare a package?
=item Bareword found in conditional
-(W) The compiler found a bareword where it expected a conditional,
+(W bareword) The compiler found a bareword where it expected a conditional,
which often indicates that an || or && was parsed as part of the
last argument of the previous construct, for example:
=item Binary number > 0b11111111111111111111111111111111 non-portable
-(W) The binary number you specified is larger than 2**32-1
+(W portable) The binary number you specified is larger than 2**32-1
(4294967295) and therefore non-portable between systems. See
L<perlport> for more on portability concerns.
=item bind() on closed socket %s
-(W) You tried to do a bind on a closed socket. Did you forget to check
+(W closed) You tried to do a bind on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/bind>.
=item Bit vector size > 32 non-portable
-(W) Using bit vector sizes larger than 32 is non-portable.
+(W portable) Using bit vector sizes larger than 32 is non-portable.
=item Bizarre copy of %s in %s
=item Buffer overflow in prime_env_iter: %s
-(W) A warning peculiar to VMS. While Perl was preparing to iterate over
+(W internal) A warning peculiar to VMS. While Perl was preparing to iterate over
%ENV, it encountered a logical name or symbol definition which was too long,
so it was truncated to the string shown.
=item Can't break at that line
-(S) A warning intended to only be printed while running within the debugger, indicating
+(S internal) A warning intended to only be printed while running within the debugger, indicating
the line number specified wasn't the location of a statement that could
be stopped at.
=item Can't do inplace edit on %s: %s
-(S) The creation of the new file failed for the indicated reason.
+(S inplace) The creation of the new file failed for the indicated reason.
=item Can't do inplace edit without backup
=item Can't do inplace edit: %s would not be unique
-(S) Your filesystem does not support filenames longer than 14
+(S inplace) Your filesystem does not support filenames longer than 14
characters and Perl was unable to create a unique filename during
inplace editing with the B<-i> switch. The file was ignored.
=item Can't do inplace edit: %s is not a regular file
-(S) You tried to use the B<-i> switch on a special file, such as a file in
+(S inplace) You tried to use the B<-i> switch on a special file, such as a file in
/dev, or a FIFO. The file was ignored.
=item Can't do setegid!
=item Can't exec "%s": %s
-(W) An system(), exec(), or piped open call could not execute the named
+(W exec) An system(), exec(), or piped open call could not execute the named
program for the indicated reason. Typical reasons include: the permissions
were wrong on the file, the file wasn't found in C<$ENV{PATH}>, the
executable in question was compiled for another architecture, or the
=item Can't ignore signal CHLD, forcing to default
-(W) Perl has detected that it is being run with the SIGCHLD signal
+(W signal) Perl has detected that it is being run with the SIGCHLD signal
(sometimes known as SIGCLD) disabled. Since disabling this signal
will interfere with proper determination of exit status of child
processes, Perl has reset the signal to its default value.
=item Can't locate package %s for @%s::ISA
-(W) The @ISA array contained the name of another package that doesn't seem
+(W syntax) The @ISA array contained the name of another package that doesn't seem
to exist.
=item Can't make list assignment to \%ENV on this system
=item Can't open %s: %s
-(S) The implicit opening of a file through use of the C<E<lt>E<gt>>
+(S inplace) The implicit opening of a file through use of the C<E<lt>E<gt>>
filehandle, either implicitly under the C<-n> or C<-p> command-line
switches, or explicitly, failed for the indicated reason. Usually this
is because you don't have read permission for a file which you named
=item Can't open bidirectional pipe
-(W) You tried to say C<open(CMD, "|cmd|")>, which is not supported. You can
+(W pipe) You tried to say C<open(CMD, "|cmd|")>, which is not supported. You can
try any of several modules in the Perl library to do this, such as
IPC::Open2. Alternately, direct the pipe's output to a file using "E<gt>",
and then read it in under a different file handle.
=item Can't remove %s: %s, skipping file
-(S) You requested an inplace edit without creating a backup file. Perl
+(S inplace) You requested an inplace edit without creating a backup file. Perl
was unable to remove the original file to replace it with the modified
file. The file was left unmodified.
=item Can't rename %s to %s: %s, skipping file
-(S) The rename done by the B<-i> switch failed for some reason,
+(S inplace) The rename done by the B<-i> switch failed for some reason,
probably because you don't have write permission to the directory.
=item Can't reopen input pipe (name: %s) in binary mode
=item Can't use \%c to mean $%c in expression
-(W) In an ordinary expression, backslash is a unary operator that creates
+(W syntax) In an ordinary expression, backslash is a unary operator that creates
a reference to its argument. The use of backslash to indicate a backreference
to a matched substring is valid only as part of a regular expression pattern.
Trying to do this in ordinary Perl code produces a value that prints
=item Character class syntax [%s] belongs inside character classes
-(W) The character class constructs [: :], [= =], and [. .] go
+(W unsafe) The character class constructs [: :], [= =], and [. .] go
I<inside> character classes, the [] are part of the construct,
for example: /[012[:alpha:]345]/. Note that [= =] and [. .]
are not currently implemented; they are simply placeholders for
=item Character class syntax [. .] is reserved for future extensions
-(W) Within regular expression character classes ([]) the syntax beginning
+(W regexp) Within regular expression character classes ([]) the syntax beginning
with "[." and ending with ".]" is reserved for future extensions.
If you need to represent those character sequences inside a regular
expression character class, just quote the square brackets with the
=item Character class syntax [= =] is reserved for future extensions
-(W) Within regular expression character classes ([]) the syntax
+(W regexp) Within regular expression character classes ([]) the syntax
beginning with "[=" and ending with "=]" is reserved for future extensions.
If you need to represent those character sequences inside a regular
expression character class, just quote the square brackets with the
=item chmod() mode argument is missing initial 0
-(W) A novice will sometimes say
+(W chmod) A novice will sometimes say
chmod 777, $filename
=item Close on unopened file E<lt>%sE<gt>
-(W) You tried to close a filehandle that was never opened.
+(W unopened) You tried to close a filehandle that was never opened.
=item Compilation failed in require
=item Complex regular subexpression recursion limit (%d) exceeded
-(W) The regular expression engine uses recursion in complex situations
+(W regexp) The regular expression engine uses recursion in complex situations
where back-tracking is required. Recursion depth is limited to 32766,
or perhaps less in architectures where the stack cannot grow
arbitrarily. ("Simple" and "medium" situations are handled without
=item connect() on closed socket %s
-(W) You tried to do a connect on a closed socket. Did you forget to check
+(W closed) You tried to do a connect on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/connect>.
=item Constant is not %s reference
=item Constant subroutine %s redefined
-(S|W) You redefined a subroutine which had previously been eligible for
+(S|W redefine) You redefined a subroutine which had previously been eligible for
inlining. See L<perlsub/"Constant Functions"> for commentary and
workarounds.
=item Constant subroutine %s undefined
-(W) You undefined a subroutine which had previously been eligible for
+(W misc) You undefined a subroutine which had previously been eligible for
inlining. See L<perlsub/"Constant Functions"> for commentary and
workarounds.
=item Deep recursion on subroutine "%s"
-(W) This subroutine has called itself (directly or indirectly) 100
+(W recursion) This subroutine has called itself (directly or indirectly) 100
times more than it has returned. This probably indicates an infinite
recursion, unless you're writing strange benchmark programs, in which
case it indicates something else.
=item defined(@array) is deprecated
-(D) defined() is not usually useful on arrays because it checks for an
+(D deprecated) defined() is not usually useful on arrays because it checks for an
undefined I<scalar> value. If you want to see if the array is empty,
just use C<if (@array) { # not empty }> for example.
=item defined(%hash) is deprecated
-(D) defined() is not usually useful on hashes because it checks for an
+(D deprecated) defined() is not usually useful on hashes because it checks for an
undefined I<scalar> value. If you want to see if the hash is empty,
just use C<if (%hash) { # not empty }> for example.
=item Did you mean "local" instead of "our"?
-(W) Remember that "our" does not localize the declared global variable.
+(W misc) Remember that "our" does not localize the declared global variable.
You have declared it again in the same lexical scope, which seems superfluous.
=item Did you mean $ or @ instead of %?
=item Duplicate free() ignored
-(S) An internal routine called free() on something that had already
+(S malloc) An internal routine called free() on something that had already
been freed.
=item elseif should be elsif
=item Exiting eval via %s
-(W) You are exiting an eval by unconventional means, such as
+(W exiting) You are exiting an eval by unconventional means, such as
+a goto, or a loop control statement.
+
+=item Exiting format via %s
+
+(W exiting) You are exiting an eval by unconventional means, such as
a goto, or a loop control statement.
=item Exiting pseudo-block via %s
-(W) You are exiting a rather special block construct (like a sort block or
+(W exiting) You are exiting a rather special block construct (like a sort block or
subroutine) by unconventional means, such as a goto, or a loop control
statement. See L<perlfunc/sort>.
=item Exiting subroutine via %s
-(W) You are exiting a subroutine by unconventional means, such as
+(W exiting) You are exiting a subroutine by unconventional means, such as
a goto, or a loop control statement.
=item Exiting substitution via %s
-(W) You are exiting a substitution by unconventional means, such as
+(W exiting) You are exiting a substitution by unconventional means, such as
a return, a goto, or a loop control statement.
=item Explicit blessing to '' (assuming package main)
-(W) You are blessing a reference to a zero length string. This has
+(W misc) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
package, e.g. bless($ref, $p || 'MyPackage');
=item false [] range "%s" in regexp
-(W) A character class range must start and end at a literal character, not
+(W regexp) A character class range must start and end at a literal character, not
another character class like C<\d> or C<[:alpha:]>. The "-" in your false
range is interpreted as a literal "-". Consider quoting the "-", "\-".
See L<perlre>.
=item Filehandle %s never opened
-(W) An I/O operation was attempted on a filehandle that was never initialized.
+(W unopened) An I/O operation was attempted on a filehandle that was never initialized.
You need to do an open() or a socket() call, or call a constructor from
the FileHandle package.
=item Filehandle %s opened only for input
-(W) You tried to write on a read-only filehandle. If you
+(W io) You tried to write on a read-only filehandle. If you
intended it to be a read-write filehandle, you needed to open it with
"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
you intended only to write the file, use "E<gt>" or "E<gt>E<gt>". See
=item Filehandle %s opened only for output
-(W) You tried to read from a filehandle opened only for writing. If you
+(W io) You tried to read from a filehandle opened only for writing. If you
intended it to be a read/write filehandle, you needed to open it with
"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing. If
you intended only to read from the file, use "E<lt>". See
=item flock() on closed filehandle %s
-(W) The filehandle you're attempting to flock() got itself closed some
+(W closed) The filehandle you're attempting to flock() got itself closed some
time before now. Check your logic flow. flock() operates on filehandles.
Are you attempting to call flock() on a dirhandle by the same name?
=item Format %s redefined
-(W) You redefined a format. To suppress this warning, say
+(W redefine) You redefined a format. To suppress this warning, say
{
no warnings;
=item Found = in conditional, should be ==
-(W) You said
+(W syntax) You said
if ($foo = 123)
=item get%sname() on closed socket %s
-(W) You tried to get a socket or peer socket name on a closed socket.
+(W closed) You tried to get a socket or peer socket name on a closed socket.
Did you forget to check the return value of your socket() call?
=item getpwnam returned invalid UIC %#o for user "%s"
(S) A warning peculiar to VMS. The call to C<sys$getuai> underlying the
C<getpwnam> operator returned an invalid UIC.
+=item glob failed (%s)
+
+(W glob) Something went wrong with the external program(s) used for C<glob>
+and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
+pattern that caused the external program to fail and exit with a nonzero
+status. If the message indicates that the abnormal exit resulted in a
+coredump, this may also mean that your csh (C shell) is broken. If so,
+you should change all of the csh-related variables in config.sh: If you
+have tcsh, make the variables refer to it as if it were csh (e.g.
+C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
+C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
+In either case, after editing config.sh, run C<./Configure -S> and
+rebuild Perl.
+
=item Glob not terminated
(F) The lexer saw a left angle bracket in a place where it was expecting
=item Had to create %s unexpectedly
-(S) A routine asked for a symbol from a symbol table that ought to have
+(S internal) A routine asked for a symbol from a symbol table that ought to have
existed already, but for some reason it didn't, and had to be created on
an emergency basis to prevent a core dump.
=item Hash %%s missing the % in argument %d of %s()
-(D) Really old Perl let you omit the % on hash names in some spots. This
+(D deprecated) Really old Perl let you omit the % on hash names in some spots. This
is now heavily deprecated.
=item Hexadecimal number > 0xffffffff non-portable
-(W) The hexadecimal number you specified is larger than 2**32-1
+(W portable) The hexadecimal number you specified is larger than 2**32-1
(4294967295) and therefore non-portable between systems. See
L<perlport> for more on portability concerns.
=item Ill-formed CRTL environ value "%s"
-(W) A warning peculiar to VMS. Perl tried to read the CRTL's internal
+(W internal) A warning peculiar to VMS. Perl tried to read the CRTL's internal
environ array, and encountered an element without the C<=> delimiter
used to spearate keys from values. The element is ignored.
=item Ill-formed message in prime_env_iter: |%s|
-(W) A warning peculiar to VMS. Perl tried to read a logical name
+(W internal) A warning peculiar to VMS. Perl tried to read a logical name
or CLI symbol definition when preparing to iterate over %ENV, and
didn't see the expected delimiter between key and value, so the
line was ignored.
=item Illegal binary digit %s ignored
-(W) You may have tried to use a digit other than 0 or 1 in a binary number.
+(W digit) You may have tried to use a digit other than 0 or 1 in a binary number.
Interpretation of the binary number stopped before the offending digit.
=item Illegal octal digit %s ignored
-(W) You may have tried to use an 8 or 9 in a octal number. Interpretation
+(W digit) You may have tried to use an 8 or 9 in a octal number. Interpretation
of the octal number stopped before the 8 or 9.
=item Illegal hexadecimal digit %s ignored
-(W) You may have tried to use a character other than 0 - 9 or A - F, a - f
+(W digit) You may have tried to use a character other than 0 - 9 or A - F, a - f
in a hexadecimal number. Interpretation of the hexadecimal number stopped
before the illegal character.
=item Integer overflow in %s number
-(W) The hexadecimal, octal or binary number you have specified either
+(W overflow) The hexadecimal, octal or binary number you have specified either
as a literal or as an argument to hex() or oct() is too big for your
architecture, and has been converted to a floating point number. On a
32-bit architecture the largest hexadecimal, octal or binary number
(P) Something went badly wrong in the regular expression parser.
-=item glob failed (%s)
-
-(W) Something went wrong with the external program(s) used for C<glob>
-and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
-pattern that caused the external program to fail and exit with a nonzero
-status. If the message indicates that the abnormal exit resulted in a
-coredump, this may also mean that your csh (C shell) is broken. If so,
-you should change all of the csh-related variables in config.sh: If you
-have tcsh, make the variables refer to it as if it were csh (e.g.
-C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
-C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
-In either case, after editing config.sh, run C<./Configure -S> and
-rebuild Perl.
-
=item internal urp in regexp at /%s/
(P) Something went badly awry in the regular expression parser.
=item Invalid conversion in %s: "%s"
-(W) Perl does not understand the given format conversion.
+(W printf) Perl does not understand the given format conversion.
See L<perlfunc/sprintf>.
=item Invalid separator character %s in attribute list
=item Invalid type in pack: '%s'
(F) The given character is not a valid pack type. See L<perlfunc/pack>.
-(W) The given character is not a valid pack type but used to be silently
+(W pack) The given character is not a valid pack type but used to be silently
ignored.
=item Invalid type in unpack: '%s'
(F) The given character is not a valid unpack type. See L<perlfunc/unpack>.
-(W) The given character is not a valid unpack type but used to be silently
+(W unpack) The given character is not a valid unpack type but used to be silently
ignored.
=item ioctl is not implemented
=item listen() on closed socket %s
-(W) You tried to do a listen on a closed socket. Did you forget to check
+(W closed) You tried to do a listen on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/listen>.
=item Lvalue subs returning %s not implemented yet
=item Misplaced _ in number
-(W) An underline in a decimal constant wasn't on a 3-digit boundary.
+(W syntax) An underline in a decimal constant wasn't on a 3-digit boundary.
=item Missing $ on loop variable
=item Missing command in piped open
-(W) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
+(W pipe) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
construction, but the command was missing or blank.
=item Missing operator before %s?
=item Multidimensional syntax %s not supported
-(W) Multidimensional arrays aren't written like C<$foo[1,2,3]>. They're written
+(W syntax) Multidimensional arrays aren't written like C<$foo[1,2,3]>. They're written
like C<$foo[1][2][3]>, as in C.
=item Missing name in "my sub"
=item Name "%s::%s" used only once: possible typo
-(W) Typographical errors often show up as unique variable names.
+(W once) Typographical errors often show up as unique variable names.
If you had a good reason for having a unique name, then just mention
it again somehow to suppress the message. The C<our> declaration is
provided for this purpose.
=item No such signal: SIG%s
-(W) You specified a signal name as a subscript to %SIG that was not recognized.
+(W signal) You specified a signal name as a subscript to %SIG that was not recognized.
Say C<kill -l> in your shell to see the valid signal names on your system.
=item no UTC offset information; assuming local time is UTC
=item Not enough format arguments
-(W) A format specified more picture fields than the next line supplied.
+(W syntax) A format specified more picture fields than the next line supplied.
See L<perlform>.
=item Null filename used
=item NULL OP IN RUN
-(P) Some internal routine called run() with a null opcode pointer.
+(P debugging) Some internal routine called run() with a null opcode pointer.
=item Null realloc
=item Octal number > 037777777777 non-portable
-(W) The octal number you specified is larger than 2**32-1 (4294967295)
+(W portable) The octal number you specified is larger than 2**32-1 (4294967295)
and therefore non-portable between systems. See L<perlport> for more
on portability concerns.
=item Odd number of elements in hash assignment
-(W) You specified an odd number of elements to initialize a hash, which
+(W misc) You specified an odd number of elements to initialize a hash, which
is odd, because hashes come in key/value pairs.
=item Offset outside string
=item oops: oopsAV
-(S) An internal warning that the grammar is screwed up.
+(S internal) An internal warning that the grammar is screwed up.
=item oops: oopsHV
-(S) An internal warning that the grammar is screwed up.
+(S internal) An internal warning that the grammar is screwed up.
=item Operation `%s': no method found, %s
=item Operator or semicolon missing before %s
-(S) You used a variable or subroutine call where the parser was
+(S ambiguous) You used a variable or subroutine call where the parser was
expecting an operator. The parser has assumed you really meant
to use an operator, but this is highly likely to be incorrect.
For example, if you say "*foo *foo" it will be interpreted as
=item page overflow
-(W) A single call to write() produced more lines than can fit on a page.
+(W io) A single call to write() produced more lines than can fit on a page.
See L<perlform>.
=item panic: ck_grep
=item Parentheses missing around "%s" list
-(W) You said something like
+(W parenthesis) You said something like
my $foo, $bar = @_;
=item pid %x not a child
-(W) A warning peculiar to VMS. Waitpid() was asked to wait for a process which
+(W exec) A warning peculiar to VMS. Waitpid() was asked to wait for a process which
isn't a subprocess of the current process. While this is fine from VMS'
perspective, it's probably not what you intended.
=item Possible Y2K bug: %s
-(W) You are concatenating the number 19 with another number, which
+(W y2k) You are concatenating the number 19 with another number, which
could be a potential Year 2000 problem.
=item Possible attempt to put comments in qw() list
-(W) qw() lists contain items separated by whitespace; as with literal
+(W qw) qw() lists contain items separated by whitespace; as with literal
strings, comment characters are not ignored, but are instead treated
as literal data. (You may have used different delimiters than the
parentheses shown here; braces are also frequently used.)
=item Possible attempt to separate words with commas
-(W) qw() lists contain items separated by whitespace; therefore commas
+(W qw) qw() lists contain items separated by whitespace; therefore commas
aren't needed to separate the items. (You may have used different
delimiters than the parentheses shown here; braces are also frequently
used.)
=item Precedence problem: open %s should be open(%s)
-(S) The old irregular construct
+(S precedence) The old irregular construct
open FOO || die;
=item print() on closed filehandle %s
-(W) The filehandle you're printing on got itself closed sometime before now.
+(W closed) The filehandle you're printing on got itself closed sometime before now.
Check your logic flow.
=item printf() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item Prototype mismatch: %s vs %s
-(S) The subroutine being declared or defined had previously been declared
+(S unsafe) The subroutine being declared or defined had previously been declared
or defined with a different function prototype.
=item Range iterator outside integer range
=item readline() on closed filehandle %s
-(W) The filehandle you're reading from got itself closed sometime before now.
+(W closed) The filehandle you're reading from got itself closed sometime before now.
Check your logic flow.
=item realloc() of freed memory ignored
-(S) An internal routine called realloc() on something that had already
+(S malloc) An internal routine called realloc() on something that had already
been freed.
=item Reallocation too large: %lx
=item Recompile perl with B<-D>DEBUGGING to use B<-D> switch
-(F) You can't use the B<-D> option unless the code to produce the
+(F debugging) You can't use the B<-D> option unless the code to produce the
desired output is compiled into Perl, which entails some overhead,
which is why it's currently left out of your copy.
=item Reference found where even-sized list expected
-(W) You gave a single reference where Perl was expecting a list with
+(W misc) You gave a single reference where Perl was expecting a list with
an even number of elements (for assignment to a hash). This
usually means that you used the anon hash constructor when you meant
to use parens. In any case, a hash requires key/value B<pairs>.
=item Reference is already weak
-(W) You have attempted to weaken a reference that is already weak.
+(W misc) You have attempted to weaken a reference that is already weak.
Doing so has no effect.
=item Reference miscount in sv_replace()
-(W) The internal sv_replace() function was handed a new SV with a
+(W internal) The internal sv_replace() function was handed a new SV with a
reference count of other than 1.
=item regexp *+ operand could be empty
=item Reversed %s= operator
-(W) You wrote your assignment operator backwards. The = must always
+(W syntax) You wrote your assignment operator backwards. The = must always
comes last, to avoid ambiguity with subsequent unary operators.
=item Runaway format
=item Scalar value @%s[%s] better written as $%s[%s]
-(W) You've used an array slice (indicated by @) to select a single element of
+(W syntax) You've used an array slice (indicated by @) to select a single element of
an array. Generally it's better to ask for a scalar value (indicated by $).
The difference is that C<$foo[&bar]> always behaves like a scalar, both when
assigning to it and when evaluating its argument, while C<@foo[&bar]> behaves
=item Scalar value @%s{%s} better written as $%s{%s}
-(W) You've used a hash slice (indicated by @) to select a single element of
+(W syntax) You've used a hash slice (indicated by @) to select a single element of
a hash. Generally it's better to ask for a scalar value (indicated by $).
The difference is that C<$foo{&bar}> always behaves like a scalar, both when
assigning to it and when evaluating its argument, while C<@foo{&bar}> behaves
=item %sseek() on unopened file
-(W) You tried to use the seek() or sysseek() function on a filehandle that
+(W unopened) You tried to use the seek() or sysseek() function on a filehandle that
was either never opened or has since been closed.
=item select not implemented
=item semi-panic: attempt to dup freed string
-(S) The internal newSVsv() routine was called to duplicate a scalar
+(S internal) The internal newSVsv() routine was called to duplicate a scalar
that had previously been marked as free.
=item Semicolon seems to be missing
-(W) A nearby syntax error was probably caused by a missing semicolon,
+(W semicolon) A nearby syntax error was probably caused by a missing semicolon,
or possibly some other missing operator, such as a comma.
=item send() on closed socket %s
-(W) The socket you're sending to got itself closed sometime before now.
+(W closed) The socket you're sending to got itself closed sometime before now.
Check your logic flow.
=item Sequence (? incomplete
=item shutdown() on closed socket %s
-(W) You tried to do a shutdown on a closed socket. Seems a bit superfluous.
+(W closed) You tried to do a shutdown on a closed socket. Seems a bit superfluous.
=item SIG%s handler "%s" not defined
-(W) The signal handler named in %SIG doesn't, in fact, exist. Perhaps you
+(W signal) The signal handler named in %SIG doesn't, in fact, exist. Perhaps you
put it into the wrong package?
=item sort is now a reserved word
=item Stat on unopened file E<lt>%sE<gt>
-(W) You tried to use the stat() function (or an equivalent file test)
+(W unopened) You tried to use the stat() function (or an equivalent file test)
on a filehandle that was either never opened or has since been closed.
=item Statement unlikely to be reached
-(W) You did an exec() with some statement after it other than a die().
+(W exec) You did an exec() with some statement after it other than a die().
This is almost always an error, because exec() never returns unless
there was a failure. You probably wanted to use system() instead,
which does return. To suppress this warning, put the exec() in a block
=item Strange *+?{} on zero-length expression
-(W) You applied a regular expression quantifier in a place where it
+(W regexp) You applied a regular expression quantifier in a place where it
makes no sense, such as on a zero-width assertion.
Try putting the quantifier inside the assertion instead. For example,
the way to match "abc" provided that it is followed by three
=item Subroutine %s redefined
-(W) You redefined a subroutine. To suppress this warning, say
+(W redefine) You redefined a subroutine. To suppress this warning, say
{
no warnings;
=item substr outside of string
-(S),(W) You tried to reference a substr() that pointed outside of a
+(W substr),(F) You tried to reference a substr() that pointed outside of a
string. That is, the absolute value of the offset was larger than the
length of the string. See L<perlfunc/substr>. This warning is
-mandatory if substr is used in an lvalue context (as the left hand side
+fatal if substr is used in an lvalue context (as the left hand side
of an assignment or as a subroutine argument for example).
=item suidperl is no longer needed since %s
=item syswrite() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item Target of goto is too deeply nested
=item tell() on unopened file
-(W) You tried to use the tell() function on a filehandle that was either
+(W unopened) You tried to use the tell() function on a filehandle that was either
never opened or has since been closed.
=item Test on unopened file E<lt>%sE<gt>
-(W) You tried to invoke a file test operator on a filehandle that isn't
+(W unopened) You tried to invoke a file test operator on a filehandle that isn't
open. Check your logic. See also L<perlfunc/-X>.
=item That use of $[ is unsupported
=item This Perl can't set CRTL environ elements (%s=%s)
-(W) Warnings peculiar to VMS. You tried to change or delete an element
+(W internal) Warnings peculiar to VMS. You tried to change or delete an element
of the CRTL's internal environ array, but your copy of Perl wasn't
built with a CRTL that contained the setenv() function. You'll need to
rebuild Perl with a CRTL that does, or redefine F<PERL_ENV_TABLES> (see
=item umask: argument is missing initial 0
-(W) A umask of 222 is incorrect. It should be 0222, because octal
+(W umask) A umask of 222 is incorrect. It should be 0222, because octal
literals always start with 0 in Perl, as in C.
=item umask not implemented
=item Unbalanced context: %d more PUSHes than POPs
-(W) The exit code detected an internal inconsistency in how many execution
+(W internal) The exit code detected an internal inconsistency in how many execution
contexts were entered and left.
=item Unbalanced saves: %d more saves than restores
-(W) The exit code detected an internal inconsistency in how many
+(W internal) The exit code detected an internal inconsistency in how many
values were temporarily localized.
=item Unbalanced scopes: %d more ENTERs than LEAVEs
-(W) The exit code detected an internal inconsistency in how many blocks
+(W internal) The exit code detected an internal inconsistency in how many blocks
were entered and left.
=item Unbalanced tmps: %d more allocs than frees
-(W) The exit code detected an internal inconsistency in how many mortal
+(W internal) The exit code detected an internal inconsistency in how many mortal
scalars were allocated and freed.
=item Undefined format "%s" called
=item Undefined value assigned to typeglob
-(W) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
+(W misc) An undefined value was assigned to a typeglob, a la C<*foo = undef>.
This does nothing. It's possible that you really mean C<undef *foo>.
=item unexec of %s into %s failed!
=item Unquoted string "%s" may clash with future reserved word
-(W) You used a bareword that might someday be claimed as a reserved word.
+(W reserved) You used a bareword that might someday be claimed as a reserved word.
It's best to put such a word in quotes, or capitalize it somehow, or insert
an underbar into it. You might also declare it as a subroutine.
=item Unrecognized escape \\%c passed through
-(W) You used a backslash-character combination which is not recognized
+(W misc) You used a backslash-character combination which is not recognized
by Perl.
=item Unrecognized signal name "%s"
=item Unsuccessful %s on filename containing newline
-(W) A file operation was attempted on a filename, and that operation
+(W newline) A file operation was attempted on a filename, and that operation
failed, PROBABLY because the filename contained a newline, PROBABLY
because you forgot to chop() or chomp() it off. See L<perlfunc/chomp>.
=item Use of $# is deprecated
-(D) This was an ill-advised attempt to emulate a poorly defined B<awk> feature.
+(D deprecated) This was an ill-advised attempt to emulate a poorly defined B<awk> feature.
Use an explicit printf() or sprintf() instead.
=item Use of $* is deprecated
-(D) This variable magically turned on multi-line pattern matching, both for
+(D deprecated) This variable magically turned on multi-line pattern matching, both for
you and for any luckless subroutine that you happen to call. You should
use the new C<//m> and C<//s> modifiers now to do that without the dangerous
action-at-a-distance effects of C<$*>.
=item Use of bare E<lt>E<lt> to mean E<lt>E<lt>"" is deprecated
-(D) You are now encouraged to use the explicitly quoted form if you
+(D deprecated) You are now encouraged to use the explicitly quoted form if you
wish to use an empty line as the terminator of the here-document.
=item Use of implicit split to @_ is deprecated
-(D) It makes a lot of work for the compiler when you clobber a
+(D deprecated) It makes a lot of work for the compiler when you clobber a
subroutine's argument list, so it's better if you assign the results of
a split() explicitly to an array (or list).
=item Use of inherited AUTOLOAD for non-method %s() is deprecated
-(D) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
+(D deprecated) As an (ahem) accidental feature, C<AUTOLOAD> subroutines are looked
up as methods (using the C<@ISA> hierarchy) even when the subroutines to
be autoloaded were called as plain functions (e.g. C<Foo::bar()>), not
as methods (e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>).
=item Use of reserved word "%s" is deprecated
-(D) The indicated bareword is a reserved word. Future versions of perl
+(D deprecated) The indicated bareword is a reserved word. Future versions of perl
may use it as a keyword, so you're better off either explicitly quoting
the word in a manner appropriate for its context of use, or using a
different name altogether. The warning can be suppressed for subroutine
=item Use of %s is deprecated
-(D) The construct indicated is no longer recommended for use, generally
+(D deprecated) The construct indicated is no longer recommended for use, generally
because there's a better way to do it, and also because the old way has
bad side effects.
=item Use of uninitialized value%s
-(W) An undefined value was used as if it were already defined. It was
+(W uninitialized) An undefined value was used as if it were already defined. It was
interpreted as a "" or a 0, but maybe it was a mistake. To suppress this
warning assign a defined value to your variables.
=item Useless use of %s in void context
-(W) You did something without a side effect in a context that does nothing
+(W void) You did something without a side effect in a context that does nothing
with the return value, such as a statement that doesn't return a value
from a block, or the left side of a scalar comma operator. Very often
this points not to stupidity on your part, but a failure of Perl to parse
=item untie attempted while %d inner references still exist
-(W) A copy of the object returned from C<tie> (or C<tied>) was still
+(W untie) A copy of the object returned from C<tie> (or C<tied>) was still
valid when C<untie> was called.
=item Value of %s can be "0"; test with defined()
-(W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
+(W misc) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>,
or C<readdir()> as a boolean value. Each of these constructs can return a
value of "0"; that would make the conditional expression false, which is
probably not what you intended. When using these constructs in conditional
=item Value of CLI symbol "%s" too long
-(W) A warning peculiar to VMS. Perl tried to read the value of an %ENV
+(W misc) A warning peculiar to VMS. Perl tried to read the value of an %ENV
element from a CLI symbol table, and found a resultant string longer
than 1024 characters. The return value has been truncated to 1024
characters.
=item Variable "%s" may be unavailable
-(W) An inner (nested) I<anonymous> subroutine is inside a I<named>
+(W closure) An inner (nested) I<anonymous> subroutine is inside a I<named>
subroutine, and outside that is another subroutine; and the anonymous
(innermost) subroutine is referencing a lexical variable defined in
the outermost subroutine. For example:
=item Variable "%s" will not stay shared
-(W) An inner (nested) I<named> subroutine is referencing a lexical
+(W closure) An inner (nested) I<named> subroutine is referencing a lexical
variable defined in an outer subroutine.
When the inner subroutine is called, it will probably see the value of
=item Warning: Use of "%s" without parentheses is ambiguous
-(S) You wrote a unary operator followed by something that looks like a
+(S ambiguous) You wrote a unary operator followed by something that looks like a
binary operator that could also have been interpreted as a term or
unary operator. For instance, if you know that the rand function
has a default argument of 1.0, and you write
=item write() on closed filehandle %s
-(W) The filehandle you're writing to got itself closed sometime before now.
+(W closed) The filehandle you're writing to got itself closed sometime before now.
Check your logic flow.
=item X outside of string
=item You need to quote "%s"
-(W) You assigned a bareword as a signal handler name. Unfortunately, you
+(W syntax) You assigned a bareword as a signal handler name. Unfortunately, you
already have a subroutine of that name declared, which means that Perl 5
will try to call the subroutine when the assignment is executed, which is
probably not what you want. (If it IS what you want, put an & in front.)
=item %cetsockopt() on closed socket %s
-(W) You tried to get or set a socket option on a closed socket.
+(W closed) You tried to get or set a socket option on a closed socket.
Did you forget to check the return value of your socket() call?
See L<perlfunc/getsockopt> and L<perlfunc/setsockopt>.
=item \1 better written as $1
-(W) Outside of patterns, backreferences live on as variables. The use
+(W syntax) Outside of patterns, backreferences live on as variables. The use
of backslashes is grandfathered on the right-hand side of a
substitution, but stylistically it's better to use the variable form
because other Perl programmers will expect it, and it works better
to go back before the current one.
($package, $filename, $line, $subroutine, $hasargs,
- $wantarray, $evaltext, $is_require, $hints) = caller($i);
+ $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($i);
Here $subroutine may be C<(eval)> if the frame is not a subroutine
call, but an C<eval>. In such a case additional elements $evaltext and
C<eval EXPR> statement. In particular, for a C<eval BLOCK> statement,
$filename is C<(eval)>, but $evaltext is undefined. (Note also that
each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
-frame. C<$hints> contains pragmatic hints that the caller was
-compiled with. The C<$hints> value is subject to change between versions
-of Perl, and is not meant for external use.
+frame. C<$hints> and C<$bitmask> contain pragmatic hints that the caller
+was compiled with. The C<$hints> and C<$bitmask> values are subject to
+change between versions of Perl, and are not meant for external use.
Furthermore, when called from within the DB package, caller returns more
detailed information: it sets the list variable C<@DB::args> to be the
my $a = "2:" + 3;
-though the result will be 5.
-
With the introduction of lexical warnings, mandatory warnings now become
I<default> warnings. The difference is that although the previously
mandatory warnings are still enabled by default, they can then be
subsequently enabled or disabled with the lexical warning pragma. For
-example, in the code below, an C<"integer overflow"> warning will only
+example, in the code below, an C<"isn't numeric"> warning will only
be reported for the C<$a> variable.
my $a = "2:" + 3;
=item 1.
If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
-control warnings is used and neither C<$^W> or lexical warnings are used,
-then default warnings will be enabled and optional warnings disabled.
+control warnings is used and neither C<$^W> or the C<warnings> pragma
+are used, then default warnings will be enabled and optional warnings
+disabled.
This means that legacy code that doesn't attempt to control the warnings
will work unchanged.
=item 4.
-If a piece of code is under the control of the lexical warning pragma,
+If a piece of code is under the control of the C<warnings> pragma,
both the C<$^W> variable and the B<-w> flag will be ignored for the
scope of the lexical warning.
=back
The combined effect of 3 & 4 is that it will will allow code which uses
-the lexical warnings pragma to control the warning behavior of $^W-type
+the C<warnings> pragma to control the warning behavior of $^W-type
code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
-=head1 EXPERIMENTAL FEATURES
-
-The features described in this section are experimental, and so subject
-to change.
-
=head2 Category Hierarchy
-A B<tentative> hierarchy of "categories" have been defined to allow groups
-of warnings to be enabled/disabled in isolation. The current
-hierarchy is:
-
- all - +--- unsafe -------+--- taint
- | |
- | +--- substr
- | |
- | +--- signal
- | |
- | +--- closure
- | |
- | +--- overflow
- | |
- | +--- portable
- | |
- | +--- untie
- | |
- | +--- utf8
- |
- +--- io ---------+--- pipe
- | |
- | +--- unopened
- | |
- | +--- closed
- | |
- | +--- newline
- | |
- | +--- exec
- |
- +--- syntax ----+--- ambiguous
- | |
- | +--- semicolon
- | |
- | +--- precedence
- | |
- | +--- reserved
- | |
- | +--- digit
- | |
- | +--- parenthesis
- | |
- | +--- deprecated
- | |
- | +--- printf
- |
- +--- severe ----+--- inplace
- | |
- | +--- internal
- | |
- | +--- debugging
- |
- |--- uninitialized
- |
- +--- void
- |
- +--- recursion
- |
- +--- redefine
- |
- +--- numeric
- |
- +--- once
- |
- +--- misc
-
+A hierarchy of "categories" have been defined to allow groups of warnings
+to be enabled/disabled in isolation.
+
+The current hierarchy is:
+
+ all -+
+ |
+ +- chmod
+ |
+ +- closure
+ |
+ +- exiting
+ |
+ +- glob
+ |
+ +- io -----------+
+ | |
+ | +- closed
+ | |
+ | +- exec
+ | |
+ | +- newline
+ | |
+ | +- pipe
+ | |
+ | +- unopened
+ |
+ +- misc
+ |
+ +- numeric
+ |
+ +- once
+ |
+ +- overflow
+ |
+ +- pack
+ |
+ +- portable
+ |
+ +- recursion
+ |
+ +- redefine
+ |
+ +- regexp
+ |
+ +- severe -------+
+ | |
+ | +- debugging
+ | |
+ | +- inplace
+ | |
+ | +- internal
+ | |
+ | +- malloc
+ |
+ +- signal
+ |
+ +- substr
+ |
+ +- syntax -------+
+ | |
+ | +- ambiguous
+ | |
+ | +- bareword
+ | |
+ | +- deprecated
+ | |
+ | +- digit
+ | |
+ | +- parenthesis
+ | |
+ | +- precedence
+ | |
+ | +- printf
+ | |
+ | +- prototype
+ | |
+ | +- qw
+ | |
+ | +- reserved
+ | |
+ | +- semicolon
+ |
+ +- taint
+ |
+ +- umask
+ |
+ +- uninitialized
+ |
+ +- unpack
+ |
+ +- untie
+ |
+ +- utf8
+ |
+ +- void
+ |
+ +- y2k
Just like the "strict" pragma any of these categories can be combined
no warnings qw(io syntax untie) ;
Also like the "strict" pragma, if there is more than one instance of the
-warnings pragma in a given scope the cumulative effect is additive.
+C<warnings> pragma in a given scope the cumulative effect is additive.
use warnings qw(void) ; # only "void" warnings enabled
...
...
no warnings qw(void) ; # only "io" warnings enabled
+To determine which category a specific warning has been assigned to see
+L<perldiag>.
=head2 Fatal Warnings
The presence of the word "FATAL" in the category list will escalate any
-warnings from the category/categories specified that are detected in
-the lexical scope into fatal errors. In the code below, there are 3
-places where a deprecated warning will be detected, the middle one will
-produce a fatal error.
+warnings detected from the categories specified in the lexical scope
+into fatal errors. In the code below, there are 3 places where a
+deprecated warning will be detected, the middle one will produce a
+fatal error.
use warnings ;
}
$a = 1 if $a EQ $b ;
-
-=head1 TODO
-
-The experimental features need bottomed out.
- perldiag.pod
- Need to add warning class information and notes on
- how to use the class info with the warnings pragma.
+=head2 Reporting Warnings from a Module
+
+The C<warnings> pragma provides two functions, namely C<warnings::enabled>
+and C<warnings::warn>, that are useful for module authors. They are
+used when you want to report a module-specific warning, but only when
+the calling module has enabled warnings via the C<warnings> pragma.
+
+Consider the module C<abc> below.
+
+ package abc;
+
+ sub open
+ {
+ if (warnings::enabled("deprecated")) {
+ warnings::warn("deprecated",
+ "abc::open is deprecated. Use abc:new") ;
+ }
+ new(@_) ;
+ }
+ sub new
+ ...
+ 1 ;
+
+The function C<open> has been deprecated, so code has been included to
+display a warning message whenever the calling module has (at least) the
+"deprecated" warnings category enabled. Something like this, say.
+
+ use warnings 'deprecated';
+ use abc;
+ ...
+ abc::open($filename) ;
+
+
+If the calling module has escalated the "deprecated" warnings category
+into a fatal error like this:
+
+ use warnings 'FATAL deprecated';
+ use abc;
+ ...
+ abc::open($filename) ;
+
+then C<warnings::warn> will detect this and die after displaying the
+warning message.
+
+=head1 TODO
+
perl5db.pl
The debugger saves and restores C<$^W> at runtime. I haven't checked
whether the debugger will still work with the lexical warnings
=head1 SEE ALSO
-L<warnings>.
+L<warnings>, L<perldiag>.
=head1 AUTHOR
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
- if (ckWARN(WARN_UNSAFE) && len == 0)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && len == 0)
+ Perl_warner(aTHX_ WARN_MISC,
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
hv_undef((HV*)sv);
break;
case SVt_PVCV:
- if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
- Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined",
+ if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
+ Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
rem -= pos;
}
if (fail < 0) {
- if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+ if (lvalue || repl)
+ Perl_croak(aTHX_ "substr outside of string");
+ if (ckWARN(WARN_SUBSTR))
Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
SV *val = NEWSV(46, 0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
+ else if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
default:
DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_UNPACK))
+ Perl_warner(aTHX_ WARN_UNPACK,
"Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
default:
DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
- if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (commas++ == 0 && ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
"Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ if (ckWARN(WARN_PACK) && (SvTEMP(fromstr)
|| (SvPADTMP(fromstr)
&& !SvREADONLY(fromstr))))
{
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_PACK,
"Attempt to pack pointer to temporary value");
}
if (SvPOK(fromstr) || SvNIOK(fromstr))
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
sv_catpvn(err, prefix, sizeof(prefix)-1);
sv_catpvn(err, message, msglen);
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
+ Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
}
}
}
if (MAXARG)
count = POPi;
- EXTEND(SP, 7);
+ EXTEND(SP, 10);
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
* use the global PL_hints) */
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
HINT_PRIVATE_MASK)));
+ {
+ SV * mask ;
+ SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+ if (old_warnings == WARN_NONE || old_warnings == WARN_STD)
+ mask = newSVpvn(WARN_NONEstring, WARNsize) ;
+ else if (old_warnings == WARN_ALL)
+ mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+ else
+ mask = newSVsv(old_warnings);
+ PUSHs(sv_2mortal(mask));
+ }
RETURN;
}
s = SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) {
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
STRLEN n;
char *s = SvPV(TARG,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s",
+ Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
"about to append an integer to '19'");
}
}
if (relem == lastrelem) {
if (*relem) {
HE *didstore;
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
if (relem == firstrelem &&
SvROK(*relem) &&
( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
+ Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected");
else
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
}
tmpstr = NEWSV(29,0);
didstore = hv_store_ent(hash,*relem,tmpstr,0);
}
}
if (!fp) {
- if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+ if (ckWARN2(WARN_GLOB,WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_CLOSED,
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (can't start child: %s)",
Strerror(errno));
else
(void)do_close(PL_last_in_gv, FALSE);
}
else if (type == OP_GLOB) {
- if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
- Perl_warner(aTHX_ WARN_CLOSED,
+ if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
}
if (!scan) /* It was not CURLYX, but CURLY. */
scan = next;
- if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0)
+ if (ckWARN(WARN_REGEXP) && (minnext + deltanext == 0)
&& !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
&& maxcount <= REG_INFTY/3) /* Complement check for big count */
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Strange *+?{} on zero-length expression");
min += minnext * mincount;
is_inf_internal |= (maxcount == REG_INFTY
goto do_curly;
}
nest_check:
- if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
- Perl_warner(aTHX_ WARN_UNSAFE, "%.*s matches null string many times",
+ if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
+ Perl_warner(aTHX_ WARN_REGEXP, "%.*s matches null string many times",
PL_regcomp_parse - origparse, origparse);
}
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(*p))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c passed through",
PL_regprecomp,
*p);
posixcc[skip + 1] == ']'))))
Perl_croak(aTHX_ "Character class [:%.*s:] unknown",
t - s - 1, s + 1);
- } else if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY)
+ } else if (ckWARN(WARN_REGEXP) && !SIZE_ONLY)
/* [[=foo=]] and [[.foo.]] are still future. */
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] is reserved for future extensions", c, c);
} else {
/* Maternal grandfather:
STATIC void
S_checkposixcc(pTHX)
{
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) &&
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
(*PL_regcomp_parse == ':' ||
*PL_regcomp_parse == '=' ||
*PL_regcomp_parse == '.')) {
while(*s && isALNUM(*s))
s++;
if (*s && c == *s && s[1] == ']') {
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] belongs inside character classes", c, c);
if (c == '=' || c == '.')
- Perl_warner(aTHX_ WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_REGEXP,
"Character class syntax [%c %c] is reserved for future extensions", c, c);
}
}
ANYOF_FLAGS(ret) |= ANYOF_INVERT;
}
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
PL_regcomp_parse += numlen;
break;
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c in character class passed through",
PL_regprecomp,
(int)value);
need_class = 1;
if (range) { /* a-\d, a-[:digit:] */
if (!SIZE_ONLY) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
PL_regcomp_parse[1] != ']') {
PL_regcomp_parse++;
if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
listsv = newSVpvn("# comment\n",10);
}
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE))
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
checkposixcc();
if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
PL_regcomp_parse += numlen;
break;
default:
- if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: Unrecognized escape \\%c in character class passed through",
PL_regprecomp,
(int)value);
if (namedclass > OOB_NAMEDCLASS) {
if (range) { /* a-\d, a-[:digit:] */
if (!SIZE_ONLY) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
PL_regcomp_parse[1] != ']') {
PL_regcomp_parse++;
if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_REGEXP))
+ Perl_warner(aTHX_ WARN_REGEXP,
"/%.127s/: false [] range \"%*.*s\" in regexp",
PL_regprecomp,
PL_regcomp_parse - rangebegin,
PL_regcc = cc;
if (n >= cc->max) { /* Maximum greed exceeded? */
- if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
+ if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
REPORT_CODE_OFF+PL_regindent*2, "")
);
}
- if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
+ if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
- Perl_warner(aTHX_ WARN_UNSAFE, "%s limit (%d) exceeded",
+ Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
"Complex regular subexpression recursion",
REG_INFTY - 1);
}
Perl_croak(aTHX_
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
- if (!(CvGV(cv) && GvSTASH(CvGV(cv))
- && HvNAME(GvSTASH(CvGV(cv)))
- && strEQ(HvNAME(GvSTASH(CvGV(cv))),
- "autouse")))
- Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
+ if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE))
+ Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
"Constant subroutine %s redefined"
: "Subroutine %s redefined",
GvENAME((GV*)dstr));
- }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
}
else {
if (dtype == SVt_PVGV) {
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Undefined value assigned to typeglob");
+ if (ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
}
else
(void)SvOK_off(dstr);
break;
default: /* it had better be ten or less */
#if defined(PERL_Y2KWARN)
- if (ckWARN(WARN_MISC)) {
+ if (ckWARN(WARN_Y2K)) {
STRLEN n;
char *s = SvPV(sv,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ WARN_Y2K,
"Possible Y2K bug: %%%c %s",
c, "format string following '19'");
}
-#!./perl
-print "1..108\n";
+print "1..125\n";
#P = start of string Q = start of substr R = end of substr S = end of string
-$a = 'abcdefxyz';
-BEGIN { $^W = 1 };
+BEGIN {
+ unshift @INC, '../lib' if -d '../lib' ;
+}
+use warnings ;
+$a = 'abcdefxyz';
$SIG{__WARN__} = sub {
if ($_[0] =~ /^substr outside of string/) {
$w++;
}
};
-sub fail { !defined(shift) && $w-- };
+sub ok { print (($_[1] ? "" : "not ") . "ok $_[0]\n") }
+
+$FATAL_MSG = '^substr outside of string' ;
-print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n"); # P=Q R S
-print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n"); # P Q R S
-print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R
-print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n"); # P R Q S
-print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); # P=Q R S
-print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); # P Q R S
+ok 1, substr($a,0,3) eq 'abc'; # P=Q R S
+ok 2, substr($a,3,3) eq 'def'; # P Q R S
+ok 3, substr($a,6,999) eq 'xyz'; # P Q S R
+$b = substr($a,999,999) ; # warn # P R Q S
+ok 4, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; };# P R Q S
+ok 5, $@ =~ /$FATAL_MSG/;
+ok 6, substr($a,0,-6) eq 'abc'; # P=Q R S
+ok 7, substr($a,-3,1) eq 'x'; # P Q R S
$[ = 1;
-print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n"); # P=Q R S
-print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n"); # P Q R S
-print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R
-print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S
-print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S
-print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); # P Q R S
+ok 8, substr($a,1,3) eq 'abc' ; # P=Q R S
+ok 9, substr($a,4,3) eq 'def' ; # P Q R S
+ok 10, substr($a,7,999) eq 'xyz';# P Q S R
+$b = substr($a,999,999) ; # warn # P R Q S
+ok 11, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; } ; # P R Q S
+ok 12, $@ =~ /$FATAL_MSG/;
+ok 13, substr($a,1,-6) eq 'abc' ;# P=Q R S
+ok 14, substr($a,-3,1) eq 'x' ; # P Q R S
$[ = 0;
substr($a,3,3) = 'XYZ';
-print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+ok 15, $a eq 'abcXYZxyz' ;
substr($a,0,2) = '';
-print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+ok 16, $a eq 'cXYZxyz' ;
substr($a,0,0) = 'ab';
-print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+ok 17, $a eq 'abcXYZxyz' ;
substr($a,0,0) = '12345678';
-print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+ok 18, $a eq '12345678abcXYZxyz' ;
substr($a,-3,3) = 'def';
-print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+ok 19, $a eq '12345678abcXYZdef';
substr($a,-3,3) = '<';
-print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+ok 20, $a eq '12345678abcXYZ<' ;
substr($a,-1,1) = '12345678';
-print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+ok 21, $a eq '12345678abcXYZ12345678' ;
$a = 'abcdefxyz';
-print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n"); # P Q R=S
-print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n"); # P Q R=S
-print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n"); # P R=S Q
-print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S
-print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n"); # P Q=R=S
-print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S
-print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n"); # P=Q R=S
+ok 22, substr($a,6) eq 'xyz' ; # P Q R=S
+ok 23, substr($a,-3) eq 'xyz' ; # P Q R=S
+$b = substr($a,999,999) ; # warning # P R=S Q
+ok 24, $w-- == 1 ;
+eval{substr($a,999,999) = "" ; } ; # P R=S Q
+ok 25, $@ =~ /$FATAL_MSG/;
+ok 26, substr($a,0) eq 'abcdefxyz' ; # P=Q R=S
+ok 27, substr($a,9) eq '' ; # P Q=R=S
+ok 28, substr($a,-11) eq 'abcdefxyz'; # Q P R=S
+ok 29, substr($a,-9) eq 'abcdefxyz'; # P=Q R=S
$a = '54321';
-print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n"); # Q R P S
-print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n"); # Q R P S
-print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n"); # R P=Q S
-print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n"); # R P Q S
-print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n"); # R P Q S
-print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n"); # P=R Q S
-print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n"); # P=R Q S
-print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n"); # P R Q S
-print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n"); # P R Q S
-print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n"); # R P Q=S
-print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n"); # P=R Q S
-print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n"); # P R Q=S
-print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n"); # R P S Q
-print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n"); # P=R S Q
-print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n"); # P R S Q
-print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n"); # P S Q=R
-
-print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n"); # Q P=R S
-print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S
-print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S
-print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R
-print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n"); # P=Q=R S
-print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S
-print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S
-print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R
-print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n"); # P Q=R S
-print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S
-print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R
-print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n"); # P=Q=R S
-print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n"); # P Q=R S
-print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n"); # P=Q=R S
-print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S
-print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R
-print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n"); # P Q=R S
-print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S
-print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n"); # P Q=R=S
-print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n"); # P Q=S R
-print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n"); # Q P=R S
-print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S
-print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n"); # P=Q=R S
-print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S
-print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n"); # P Q=R S
-print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S
+$b = substr($a,-7, 1) ; # warn # Q R P S
+ok 30, $w-- == 1 ;
+eval{substr($a,-7, 1) = "" ; }; # Q R P S
+ok 31, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-7,-6) ; # warn # Q R P S
+ok 32, $w-- == 1 ;
+eval{substr($a,-7,-6) = "" ; }; # Q R P S
+ok 33, $@ =~ /$FATAL_MSG/;
+ok 34, substr($a,-5,-7) eq ''; # R P=Q S
+ok 35, substr($a, 2,-7) eq ''; # R P Q S
+ok 36, substr($a,-3,-7) eq ''; # R P Q S
+ok 37, substr($a, 2,-5) eq ''; # P=R Q S
+ok 38, substr($a,-3,-5) eq ''; # P=R Q S
+ok 39, substr($a, 2,-4) eq ''; # P R Q S
+ok 40, substr($a,-3,-4) eq ''; # P R Q S
+ok 41, substr($a, 5,-6) eq ''; # R P Q=S
+ok 42, substr($a, 5,-5) eq ''; # P=R Q S
+ok 43, substr($a, 5,-3) eq ''; # P R Q=S
+$b = substr($a, 7,-7) ; # warn # R P S Q
+ok 44, $w-- == 1 ;
+eval{substr($a, 7,-7) = "" ; }; # R P S Q
+ok 45, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7,-5) ; # warn # P=R S Q
+ok 46, $w-- == 1 ;
+eval{substr($a, 7,-5) = "" ; }; # P=R S Q
+ok 47, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7,-3) ; # warn # P Q S Q
+ok 48, $w-- == 1 ;
+eval{substr($a, 7,-3) = "" ; }; # P Q S Q
+ok 49, $@ =~ /$FATAL_MSG/;
+$b = substr($a, 7, 0) ; # warn # P S Q=R
+ok 50, $w-- == 1 ;
+eval{substr($a, 7, 0) = "" ; }; # P S Q=R
+ok 51, $@ =~ /$FATAL_MSG/;
+
+ok 52, substr($a,-7,2) eq ''; # Q P=R S
+ok 53, substr($a,-7,4) eq '54'; # Q P R S
+ok 54, substr($a,-7,7) eq '54321';# Q P R=S
+ok 55, substr($a,-7,9) eq '54321';# Q P S R
+ok 56, substr($a,-5,0) eq ''; # P=Q=R S
+ok 57, substr($a,-5,3) eq '543';# P=Q R S
+ok 58, substr($a,-5,5) eq '54321';# P=Q R=S
+ok 59, substr($a,-5,7) eq '54321';# P=Q S R
+ok 60, substr($a,-3,0) eq ''; # P Q=R S
+ok 61, substr($a,-3,3) eq '321';# P Q R=S
+ok 62, substr($a,-2,3) eq '21'; # P Q S R
+ok 63, substr($a,0,-5) eq ''; # P=Q=R S
+ok 64, substr($a,2,-3) eq ''; # P Q=R S
+ok 65, substr($a,0,0) eq ''; # P=Q=R S
+ok 66, substr($a,0,5) eq '54321';# P=Q R=S
+ok 67, substr($a,0,7) eq '54321';# P=Q S R
+ok 68, substr($a,2,0) eq ''; # P Q=R S
+ok 69, substr($a,2,3) eq '321'; # P Q R=S
+ok 70, substr($a,5,0) eq ''; # P Q=R=S
+ok 71, substr($a,5,2) eq ''; # P Q=S R
+ok 72, substr($a,-7,-5) eq ''; # Q P=R S
+ok 73, substr($a,-7,-2) eq '543';# Q P R S
+ok 74, substr($a,-5,-5) eq ''; # P=Q=R S
+ok 75, substr($a,-5,-2) eq '543';# P=Q R S
+ok 76, substr($a,-3,-3) eq ''; # P Q=R S
+ok 77, substr($a,-3,-1) eq '32';# P Q R S
$a = '';
-print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n"); # Q P=R=S
-print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n"); # P=Q=R=S
-print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n"); # P=Q=S R
-print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n"); # Q P=S R
-print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n"); # Q P=R=S
-print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n"); # P=Q=R=S
+ok 78, substr($a,-2,2) eq ''; # Q P=R=S
+ok 79, substr($a,0,0) eq ''; # P=Q=R=S
+ok 80, substr($a,0,1) eq ''; # P=Q=S R
+ok 81, substr($a,-2,3) eq ''; # Q P=S R
+ok 82, substr($a,-2) eq ''; # Q P=R=S
+ok 83, substr($a,0) eq ''; # P=Q=R=S
+
+
+ok 84, substr($a,0,-1) eq ''; # R P=Q=S
+$b = substr($a,-2, 0) ; # warn # Q=R P=S
+ok 85, $w-- == 1 ;
+eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
+ok 86, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-2, 1) ; # warn # Q R P=S
+ok 87, $w-- == 1 ;
+eval{substr($a,-2, 1) = "" ; }; # Q R P=S
+ok 88, $@ =~ /$FATAL_MSG/;
-print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n"); # R P=Q=S
-print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n"); # Q=R P=S
-print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n"); # Q R P=S
-print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n"); # Q R P=S
-print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n"); # Q=R P=S
-print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n"); # R P=S Q
-print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n"); # P=S Q R
-print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n"); # P=S Q=R
-print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n"); # P=R=S Q
+$b = substr($a,-2,-1) ; # warn # Q R P=S
+ok 89, $w-- == 1 ;
+eval{substr($a,-2,-1) = "" ; }; # Q R P=S
+ok 90, $@ =~ /$FATAL_MSG/;
+$b = substr($a,-2,-2) ; # warn # Q=R P=S
+ok 91, $w-- == 1 ;
+eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
+ok 92, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1,-2) ; # warn # R P=S Q
+ok 93, $w-- == 1 ;
+eval{substr($a, 1,-2) = "" ; }; # R P=S Q
+ok 94, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1, 1) ; # warn # P=S Q R
+ok 95, $w-- == 1 ;
+eval{substr($a, 1, 1) = "" ; }; # P=S Q R
+ok 96, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a, 1, 0) ;# warn # P=S Q=R
+ok 97, $w-- == 1 ;
+eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
+ok 98, $@ =~ /$FATAL_MSG/;
+
+$b = substr($a,1) ; # warning # P=R=S Q
+ok 99, $w-- == 1 ;
+eval{substr($a,1) = "" ; }; # P=R=S Q
+ok 100, $@ =~ /$FATAL_MSG/;
my $a = 'zxcvbnm';
substr($a,2,0) = '';
-print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n";
+ok 101, $a eq 'zxcvbnm';
substr($a,7,0) = '';
-print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n";
+ok 102, $a eq 'zxcvbnm';
substr($a,5,0) = '';
-print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n";
+ok 103, $a eq 'zxcvbnm';
substr($a,0,2) = 'pq';
-print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n";
+ok 104, $a eq 'pqcvbnm';
substr($a,2,0) = 'r';
-print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n";
+ok 105, $a eq 'pqrcvbnm';
substr($a,8,0) = 'asd';
-print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n";
+ok 106, $a eq 'pqrcvbnmasd';
substr($a,0,2) = 'iop';
-print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n";
+ok 107, $a eq 'ioprcvbnmasd';
substr($a,0,5) = 'fgh';
-print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n";
+ok 108, $a eq 'fghvbnmasd';
substr($a,3,5) = 'jkl';
-print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n";
+ok 109, $a eq 'fghjklsd';
substr($a,3,2) = '1234';
-print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n";
+ok 110, $a eq 'fgh1234lsd';
# with lexicals (and in re-entered scopes)
unless ($_) {
$txt = "Foo";
substr($txt, -1) = "X";
- print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n";
+ ok 111, $txt eq "FoX";
}
else {
- local $^W = 0; # because of (spurious?) "uninitialised value"
substr($txt, 0, 1) = "X";
- print $txt eq "X" ? "ok 95\n" : "not ok 95\n";
+ ok 112, $txt eq "X";
}
}
+$w = 0 ;
# coercion of references
{
my $s = [];
substr($s, 0, 1) = 'Foo';
- print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n";
+ ok 113, substr($s,0,7) eq "FooRRAY" && !($w-=2);
}
# check no spurious warnings
-print $w ? "not ok 97\n" : "ok 97\n";
+ok 114, $w == 0;
# check new 4 arg replacement syntax
$a = "abcxyz";
$w = 0;
-print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
-print "ok 98\n";
-print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
-print "ok 99\n";
-print "not " unless substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
-print "ok 100\n";
-
-print "not " unless substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
+ok 115, substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
+ok 116, substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
+ok 117, substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
+
+ok 118, substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
&& $w == 3;
-print "ok 101\n";
+
$w = 0;
-print "not " unless substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
-print "ok 102\n";
-print "not " unless fail(substr($a, -99, 0, ""));
-print "ok 103\n";
-print "not " unless fail(substr($a, 99, 3, ""));
-print "ok 104\n";
+ok 119, substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
+eval{substr($a, -99, 0, "") };
+ok 120, $@ =~ /$FATAL_MSG/;
+eval{substr($a, 99, 3, "") };
+ok 121, $@ =~ /$FATAL_MSG/;
substr($a, 0, length($a), "foo");
-print "not " unless $a eq "foo" && !$w;
-print "ok 105\n";
+ok 122, $a eq "foo" && !$w;
# using 4 arg substr as lvalue is a compile time error
eval 'substr($a,0,0,"") = "abc"';
-print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
-print "ok 106\n";
+ok 123, $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
$a = "abcdefgh";
-print "not " unless sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
-print "ok 107\n";
-print "not " unless $a eq 'xxxxefgh';
-print "ok 108\n";
+ok 124, sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
+ok 125, $a eq 'xxxxefgh';
local $a, $b = (1,2);
Bareword found in conditional at -e line 1.
- use warnings 'syntax'; my $x = print(ABC || 1);
+ use warnings 'bareword'; my $x = print(ABC || 1);
Value of %s may be \"0\"; use \"defined\"
$x = 1 if $x = <FH> ;
__END__
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $x ;
my $x ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $x ;
EXPECT
"my" variable $x masks earlier declaration in same scope at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'closure' ;
sub x {
my $x;
sub y {
Variable "$x" will not stay shared at - line 7.
########
# op.c
-no warnings 'unsafe' ;
+no warnings 'closure' ;
sub x {
my $x;
sub y {
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'closure' ;
sub x {
my $x;
sub y {
Variable "$x" may be unavailable at - line 6.
########
# op.c
-no warnings 'unsafe' ;
+no warnings 'closure' ;
sub x {
my $x;
sub y {
########
# op.c
BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
%$c =~ s/a/b/ ;
%$c =~ tr/a/b/ ;
{
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
@a =~ /abc/ ;
@a =~ s/a/b/ ;
Parentheses missing around "local" list at - line 3.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'bareword' ;
print (ABC || 1) ;
-no warnings 'syntax' ;
+no warnings 'bareword' ;
print (ABC || 1) ;
EXPECT
Bareword found in conditional at - line 3.
--FILE--
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
open FH, "<abc" ;
$x = 1 if $x = <FH> ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = <FH> ;
EXPECT
Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
opendir FH, "." ;
$x = 1 if $x = readdir FH ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = readdir FH ;
closedir FH ;
EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
$x = 1 if $x = <*> ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = <*> ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
%a = (1,2,3,4) ;
$x = 1 if $x = each %a ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 if $x = each %a ;
EXPECT
Value of each() operator can be "0"; test with defined() at - line 4.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 while $x = <*> and 0 ;
EXPECT
Value of glob construct can be "0"; test with defined() at - line 3.
########
# op.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
opendir FH, "." ;
$x = 1 while $x = readdir FH and 0 ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$x = 1 while $x = readdir FH and 0 ;
closedir FH ;
EXPECT
Format FRED redefined at - line 5.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'deprecated' ;
push FRED;
-no warnings 'syntax' ;
+no warnings 'deprecated' ;
push FRED;
EXPECT
Array @FRED missing the @ in argument 1 of push() at - line 3.
########
# op.c
-use warnings 'syntax' ;
+use warnings 'deprecated' ;
@a = keys FRED ;
-no warnings 'syntax' ;
+no warnings 'deprecated' ;
@a = keys FRED ;
EXPECT
Hash %FRED missing the % in argument 1 of keys() at - line 3.
sub fred() ;
sub fred($) {}
{
- no warnings 'unsafe' ;
+ no warnings 'prototype' ;
sub Fred() ;
sub Fred($) {}
- use warnings 'unsafe' ;
+ use warnings 'prototype' ;
sub freD() ;
sub freD($) {}
}
/---/ should probably be written as "---" at - line 3.
########
# op.c [Perl_peep]
-use warnings 'unsafe' ;
+use warnings 'prototype' ;
fred() ;
sub fred ($$) {}
-no warnings 'unsafe' ;
+no warnings 'prototype' ;
joe() ;
sub joe ($$) {}
EXPECT
pp.c TODO
substr outside of string
- $a = "ab" ; $a = substr($a, 4,5)
+ $a = "ab" ; $b = substr($a, 4,5) ;
Attempt to use reference as lvalue in substr
$a = "ab" ; $b = \$a ; substr($b, 1,1) = $b
# pp.c
use warnings 'substr' ;
$a = "ab" ;
-$a = substr($a, 4,5);
+$b = substr($a, 4,5) ;
no warnings 'substr' ;
$a = "ab" ;
-$a = substr($a, 4,5);
+$b = substr($a, 4,5) ;
EXPECT
substr outside of string at - line 4.
########
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a = { 1,2,3};
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my $b = { 1,2,3};
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'pack' ;
+use warnings 'unpack' ;
my @a = unpack ("A,A", "22") ;
my $a = pack ("A,A", 1,2) ;
-no warnings 'unsafe' ;
+no warnings 'pack' ;
+no warnings 'unpack' ;
my @b = unpack ("A,A", "22") ;
my $b = pack ("A,A", 1,2) ;
EXPECT
-Invalid type in unpack: ',' at - line 3.
-Invalid type in pack: ',' at - line 4.
+Invalid type in unpack: ',' at - line 4.
+Invalid type in pack: ',' at - line 5.
########
# pp.c
use warnings 'uninitialized' ;
Use of uninitialized value in scalar dereference at - line 4.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'pack' ;
sub foo { my $a = "a"; return $a . $a++ . $a++ }
my $a = pack("p", &foo) ;
-no warnings 'unsafe' ;
+no warnings 'pack' ;
my $b = pack("p", &foo) ;
EXPECT
Attempt to pack pointer to temporary value at - line 4.
########
# pp.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
bless \[], "" ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
bless \[], "" ;
EXPECT
Explicit blessing to '' (assuming package main) at - line 3.
1
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
$_ = "abc" ;
while ($i ++ == 0)
{
s/ab/last/e ;
}
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last/e ;
Exiting substitution via last at - line 7.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
sub fred { last }
{ fred() }
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
sub joe { last }
{ joe() }
EXPECT
########
# pp_ctl.c
{
- eval "use warnings 'unsafe' ; last;"
+ eval "use warnings 'exiting' ; last;"
}
print STDERR $@ ;
{
- eval "no warnings 'unsafe' ;last;"
+ eval "no warnings 'exiting' ;last;"
}
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
@a = (1,2) ;
@b = sort { last } @a ;
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a loop block at - line 4.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
$_ = "abc" ;
fred:
while ($i ++ == 0)
{
s/ab/last fred/e ;
}
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
while ($i ++ == 0)
{
s/ab/last fred/e ;
Exiting substitution via last at - line 7.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
sub fred { last joe }
joe: { fred() }
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
sub Fred { last Joe }
Joe: { Fred() }
EXPECT
########
# pp_ctl.c
joe:
-{ eval "use warnings 'unsafe' ; last joe;" }
+{ eval "use warnings 'exiting' ; last joe;" }
print STDERR $@ ;
Joe:
-{ eval "no warnings 'unsafe' ; last Joe;" }
+{ eval "no warnings 'exiting' ; last Joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'exiting' ;
@a = (1,2) ;
fred: @b = sort { last fred } @a ;
-no warnings 'unsafe' ;
+no warnings 'exiting' ;
Fred: @b = sort { last Fred } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
EXPECT
########
# pp_ctl.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
-no warnings 'unsafe' ;
+no warnings 'misc' ;
package Foo;
DESTROY { die "@{$_[0]} foo bar" }
{ bless ['A'], 'Foo' for 1..10 }
Use of uninitialized value in hash dereference at - line 4.
########
# pp_hot.c [pp_aassign]
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my %X ; %X = (1,2,3) ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my %Y ; %Y = (1,2,3) ;
EXPECT
Odd number of elements in hash assignment at - line 3.
########
# pp_hot.c [pp_aassign]
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my %X ; %X = [1 .. 3] ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
my %Y ; %Y = [1 .. 3] ;
EXPECT
Reference found where even-sized list expected at - line 3.
EXPECT
########
# pp_hot.c [pp_concat]
-use warnings 'misc';
+use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
$x = "19" . $yy . "\n";
$x = "319$yy\n";
$x = "319" . $yy . "\n";
-no warnings 'misc';
+no warnings 'y2k';
$x = "19$yy\n";
$x = "19" . $yy . "\n";
EXPECT
$a = "ABC123" ; $a =~ /(?=a)*/'
/%.127s/: Unrecognized escape \\%c passed through" [S_regatom]
- /\m/
+ $x = '\m' ; /$x/
Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
__END__
# regcomp.c [S_regpiece]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
my $a = "ABC123" ;
$a =~ /(?=a)*/ ;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$a =~ /(?=a)*/ ;
EXPECT
(?=a)* matches null string many times at - line 4.
########
# regcomp.c [S_study_chunk]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$_ = "" ;
/(?=a)?/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/(?=a)?/;
EXPECT
Strange *+?{} on zero-length expression at - line 4.
########
# regcomp.c [S_regatom]
-use warnings 'unsafe' ;
-$a =~ /a\mb\b/ ;
-no warnings 'unsafe' ;
-$a =~ /a\mb\b/ ;
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
EXPECT
-Unrecognized escape \m passed through at - line 3.
+/a\m/: Unrecognized escape \m passed through at - line 4.
########
# regcomp.c [S_regpposixcc S_checkposixcc]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$_ = "" ;
/[:alpha:]/;
/[.bar.]/;
/[[.foo.]]/;
/[[=bar=]]/;
/[:zog:]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[:alpha:]/;
/[.foo.]/;
/[=bar=]/;
########
# regcomp.c [S_regclass]
$_ = "";
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
}
use utf8;
$_ = "";
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-b]/;
/[[:alpha:]-[:digit:]]/;
/[[:digit:]-[:alpha:]]/;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
/[a-b]/;
/[a-\d]/;
/[\d-b]/;
/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 19.
########
# regcomp.c [S_regclass S_regclassutf8]
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$a =~ /[a\zb]/ ;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$a =~ /[a\zb]/ ;
EXPECT
/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3.
__END__
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-use warnings 'unsafe' ;
+use warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
########
# regexec.c
print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
-no warnings 'unsafe' ;
+no warnings 'regexp' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
Invalid conversion in printf: "%\002" at - line 8.
########
# sv.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
*a = undef ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
*b = undef ;
EXPECT
Undefined value assigned to typeglob at - line 3.
\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 12.
########
# sv.c
-use warnings 'misc';
+use warnings 'y2k';
use Config;
BEGIN {
unless ($Config{ccflags} =~ /Y2KWARN/) {
$x = sprintf "19%02d\n", 78;
$x = printf "319%02d\n", $yy;
$x = sprintf "319%02d\n", $yy;
-no warnings 'misc';
+no warnings 'y2k';
$x = printf "19%02d\n", $yy;
$x = sprintf "19%02d\n", $yy;
$x = printf "19%02d\n", 78;
Unquoted string "abc" may clash with future reserved word at - line 3.
########
# toke.c
-use warnings 'octal' ;
+use warnings 'chmod' ;
chmod 3;
-no warnings 'octal' ;
+no warnings 'chmod' ;
chmod 3;
EXPECT
chmod() mode argument is missing initial 0 at - line 3.
########
# toke.c
-use warnings 'syntax' ;
+use warnings 'qw' ;
@a = qw(a, b, c) ;
-no warnings 'syntax' ;
+no warnings 'qw' ;
@a = qw(a, b, c) ;
EXPECT
Possible attempt to separate words with commas at - line 3.
########
# toke.c
-use warnings 'syntax' ;
+use warnings 'qw' ;
@a = qw(a b #) ;
-no warnings 'syntax' ;
+no warnings 'qw' ;
@a = qw(a b #) ;
EXPECT
Possible attempt to put comments in qw() list at - line 3.
########
# toke.c
-use warnings 'octal' ;
+use warnings 'umask' ;
umask 3;
-no warnings 'octal' ;
+no warnings 'umask' ;
umask 3;
EXPECT
umask: argument is missing initial 0 at - line 3.
Misplaced _ in number at - line 4.
########
# toke.c
-use warnings 'unsafe' ;
+use warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
-no warnings 'unsafe' ;
+no warnings 'bareword' ;
#line 25 "bar"
$a = FRED:: ;
EXPECT
$^W = 0 ;
open FOO || time;
{
- no warnings 'ambiguous' ;
+ no warnings 'precedence' ;
open FOO || time;
- use warnings 'ambiguous' ;
+ use warnings 'precedence' ;
open FOO || time;
}
open FOO || time;
Ambiguous use of * resolved as operator * at - line 10.
########
# toke.c
-use warnings 'unsafe' ;
+use warnings 'misc' ;
my $a = "\m" ;
-no warnings 'unsafe' ;
+no warnings 'misc' ;
$a = "\m" ;
EXPECT
Unrecognized escape \m passed through at - line 3.
default:
{
dTHR;
- if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && isALPHA(*s))
+ Perl_warner(aTHX_ WARN_MISC,
"Unrecognized escape \\%c passed through",
*s);
/* default action is to copy the quoted character */
if (len > 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ Perl_warner(aTHX_ WARN_BAREWORD,
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
len -= 2;
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_CHMOD)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
+ Perl_warner(aTHX_ WARN_CHMOD,
"chmod() mode argument is missing initial 0");
}
LOP(OP_CHMOD,XTERM);
char *t;
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
t = skipspace(d);
- if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS))
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE))
+ Perl_warner(aTHX_ WARN_PRECEDENCE,
"Precedence problem: open %.*s should be open(%.*s)",
d-s,s, d-s,s);
}
for (; isSPACE(*d) && len; --len, ++d) ;
if (len) {
char *b = d;
- if (!warned && ckWARN(WARN_SYNTAX)) {
+ if (!warned && ckWARN(WARN_QW)) {
for (; !isSPACE(*d) && len; --len, ++d) {
if (*d == ',') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to separate words with commas");
++warned;
}
else if (*d == '#') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to put comments in qw() list");
++warned;
}
LOP(OP_UTIME,XTERM);
case KEY_umask:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_UMASK)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
+ Perl_warner(aTHX_ WARN_UMASK,
"umask: argument is missing initial 0");
}
UNI(OP_UMASK);
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x)))
-#define WARN_IO 0
-#define WARN_CLOSED 1
-#define WARN_EXEC 2
-#define WARN_NEWLINE 3
-#define WARN_PIPE 4
-#define WARN_UNOPENED 5
-#define WARN_MISC 6
-#define WARN_NUMERIC 7
-#define WARN_ONCE 8
-#define WARN_RECURSION 9
-#define WARN_REDEFINE 10
-#define WARN_SEVERE 11
-#define WARN_DEBUGGING 12
-#define WARN_INPLACE 13
-#define WARN_INTERNAL 14
-#define WARN_SYNTAX 15
-#define WARN_AMBIGUOUS 16
-#define WARN_BAREWORD 17
-#define WARN_DEPRECATED 18
-#define WARN_DIGIT 19
-#define WARN_OCTAL 20
-#define WARN_PARENTHESIS 21
-#define WARN_PRINTF 22
-#define WARN_RESERVED 23
-#define WARN_SEMICOLON 24
-#define WARN_UNINITIALIZED 25
-#define WARN_UNSAFE 26
-#define WARN_CLOSURE 27
-#define WARN_OVERFLOW 28
-#define WARN_PORTABLE 29
-#define WARN_SIGNAL 30
-#define WARN_SUBSTR 31
-#define WARN_TAINT 32
-#define WARN_UNTIE 33
-#define WARN_UTF8 34
-#define WARN_VOID 35
-
-#define WARNsize 9
-#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125"
-#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0"
+#define WARN_CHMOD 0
+#define WARN_CLOSURE 1
+#define WARN_EXITING 2
+#define WARN_GLOB 3
+#define WARN_IO 4
+#define WARN_CLOSED 5
+#define WARN_EXEC 6
+#define WARN_NEWLINE 7
+#define WARN_PIPE 8
+#define WARN_UNOPENED 9
+#define WARN_MISC 10
+#define WARN_NUMERIC 11
+#define WARN_ONCE 12
+#define WARN_OVERFLOW 13
+#define WARN_PACK 14
+#define WARN_PORTABLE 15
+#define WARN_RECURSION 16
+#define WARN_REDEFINE 17
+#define WARN_REGEXP 18
+#define WARN_SEVERE 19
+#define WARN_DEBUGGING 20
+#define WARN_INPLACE 21
+#define WARN_INTERNAL 22
+#define WARN_MALLOC 23
+#define WARN_SIGNAL 24
+#define WARN_SUBSTR 25
+#define WARN_SYNTAX 26
+#define WARN_AMBIGUOUS 27
+#define WARN_BAREWORD 28
+#define WARN_DEPRECATED 29
+#define WARN_DIGIT 30
+#define WARN_PARENTHESIS 31
+#define WARN_PRECEDENCE 32
+#define WARN_PRINTF 33
+#define WARN_PROTOTYPE 34
+#define WARN_QW 35
+#define WARN_RESERVED 36
+#define WARN_SEMICOLON 37
+#define WARN_TAINT 38
+#define WARN_UMASK 39
+#define WARN_UNINITIALIZED 40
+#define WARN_UNPACK 41
+#define WARN_UNTIE 42
+#define WARN_UTF8 43
+#define WARN_VOID 44
+#define WARN_Y2K 45
+
+#define WARNsize 12
+#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
+#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0"
/* end of file warnings.h */
sub DEFAULT_OFF () { 2 }
my $tree = {
- 'unsafe' => { 'untie' => DEFAULT_OFF,
- 'substr' => DEFAULT_OFF,
- 'taint' => DEFAULT_OFF,
- 'signal' => DEFAULT_OFF,
- 'closure' => DEFAULT_OFF,
- 'overflow' => DEFAULT_OFF,
- 'portable' => DEFAULT_OFF,
- 'utf8' => DEFAULT_OFF,
- } ,
- 'io' => { 'pipe' => DEFAULT_OFF,
+ 'io' => { 'pipe' => DEFAULT_OFF,
'unopened' => DEFAULT_OFF,
'closed' => DEFAULT_OFF,
'newline' => DEFAULT_OFF,
'exec' => DEFAULT_OFF,
- #'wr in in file'=> DEFAULT_OFF,
},
- 'syntax' => { 'ambiguous' => DEFAULT_OFF,
+ 'syntax' => { 'ambiguous' => DEFAULT_OFF,
'semicolon' => DEFAULT_OFF,
+ 'precedence' => DEFAULT_OFF,
'bareword' => DEFAULT_OFF,
'reserved' => DEFAULT_OFF,
- 'octal' => DEFAULT_OFF,
'digit' => DEFAULT_OFF,
'parenthesis' => DEFAULT_OFF,
'deprecated' => DEFAULT_OFF,
'printf' => DEFAULT_OFF,
+ 'prototype' => DEFAULT_OFF,
+ 'qw' => DEFAULT_OFF,
},
- 'severe' => { 'inplace' => DEFAULT_ON,
+ 'severe' => { 'inplace' => DEFAULT_ON,
'internal' => DEFAULT_ON,
'debugging' => DEFAULT_ON,
+ 'malloc' => DEFAULT_ON,
},
- 'void' => DEFAULT_OFF,
- 'recursion' => DEFAULT_OFF,
- 'redefine' => DEFAULT_OFF,
- 'numeric' => DEFAULT_OFF,
- 'uninitialized'=> DEFAULT_OFF,
- 'once' => DEFAULT_OFF,
- 'misc' => DEFAULT_OFF,
+ 'void' => DEFAULT_OFF,
+ 'recursion' => DEFAULT_OFF,
+ 'redefine' => DEFAULT_OFF,
+ 'numeric' => DEFAULT_OFF,
+ 'uninitialized' => DEFAULT_OFF,
+ 'once' => DEFAULT_OFF,
+ 'misc' => DEFAULT_OFF,
+ 'regexp' => DEFAULT_OFF,
+ 'glob' => DEFAULT_OFF,
+ 'y2k' => DEFAULT_OFF,
+ 'chmod' => DEFAULT_OFF,
+ 'umask' => DEFAULT_OFF,
+ 'untie' => DEFAULT_OFF,
+ 'substr' => DEFAULT_OFF,
+ 'taint' => DEFAULT_OFF,
+ 'signal' => DEFAULT_OFF,
+ 'closure' => DEFAULT_OFF,
+ 'overflow' => DEFAULT_OFF,
+ 'portable' => DEFAULT_OFF,
+ 'utf8' => DEFAULT_OFF,
+ 'exiting' => DEFAULT_OFF,
+ 'pack' => DEFAULT_OFF,
+ 'unpack' => DEFAULT_OFF,
#'default' => DEFAULT_ON,
} ;
}
###########################################################################
+sub printTree
+{
+ my $tre = shift ;
+ my $prefix = shift ;
+ my $indent = shift ;
+ my ($k, $v) ;
+
+ my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
+
+ $prefix .= " " x $indent ;
+ foreach $k (sort keys %$tre) {
+ $v = $tre->{$k};
+ print $prefix . "|\n" ;
+ print $prefix . "+- $k" ;
+ if (ref $v)
+ {
+ print " " . "-" x ($max - length $k ) . "+\n" ;
+ printTree ($v, $prefix . "|" , $max + $indent - 1)
+ }
+ else
+ { print "\n" }
+ }
+
+}
+
+###########################################################################
sub mkHex
{
###########################################################################
+if (@ARGV && $ARGV[0] eq "tree")
+{
+ print " all -+\n" ;
+ printTree($tree, " ", 4) ;
+ exit ;
+}
#unlink "warnings.h";
#unlink "lib/warnings.pm";
}
print PM " );\n\n" ;
+print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
while (<DATA>) {
print PM $_ ;
}
use warnings "all";
no warnings "all";
+ if (warnings::enabled("void") {
+ warnings::warn("void", "some warning");
+ }
+
=head1 DESCRIPTION
If no import list is supplied, all possible warnings are either enabled
or disabled.
-See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
+Two functions are provided to assist module authors.
+
+=over 4
+
+=item warnings::enabled($category)
+
+Returns TRUE if the warnings category in C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
+
+
+=item warnings::warn($category, $message)
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
+
+=back
+
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
=cut
sub enabled
{
- my $string = shift ;
-
+ # If no parameters, check for any lexical warnings enabled
+ # in the users scope.
+ my $callers_bitmask = (caller(1))[9] ;
+ return ($callers_bitmask ne $NONE) if @_ == 0 ;
+
+ # otherwise check for the category supplied.
+ my $category = shift ;
+ return 0
+ unless $Bits{$category} ;
+ return 0 unless defined $callers_bitmask ;
return 1
- if $bits{$string} && ${^WARNING_BITS} & $bits{$string} ;
+ if ($callers_bitmask & $Bits{$category}) ne $NONE ;
return 0 ;
}
+sub warn
+{
+ croak "Usage: warnings::warn('category', 'message')"
+ unless @_ == 2 ;
+ my $category = shift ;
+ my $message = shift ;
+ local $Carp::CarpLevel = 1 ;
+ my $callers_bitmask = (caller(1))[9] ;
+ croak($message)
+ if defined $callers_bitmask &&
+ ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+ carp($message) ;
+}
+
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff