X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=909d27ab3e843b9a0e68aa84564124a67f3ede89;hb=415df732a2faaabbd8689e4fea15ff6997e2cb44;hp=43a6600cfbd8a47ec803667235c8a6dd9dd110fb;hpb=1c35787c75148e768b8c61eb9aec45d6b0ea3949;p=p5sagit%2Fstrictures.git diff --git a/lib/strictures.pm b/lib/strictures.pm index 43a6600..909d27a 100644 --- a/lib/strictures.pm +++ b/lib/strictures.pm @@ -5,20 +5,30 @@ use warnings FATAL => 'all'; BEGIN { *_PERL_LT_5_8_4 = ($] < 5.008004) ? sub(){1} : sub(){0}; + *_CAN_GOTO_VERSION = ($] >= 5.008000) ? sub(){1} : sub(){0}; } -our $VERSION = '2.000000'; +our $VERSION = '1.999_002'; $VERSION = eval $VERSION; +$VERSION = 2; # a bit of a cheat, but requesting v2 needs to be possible our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( closure + chmod deprecated exiting experimental + experimental::autoderef + experimental::const_attr experimental::lexical_subs experimental::lexical_topic + experimental::postderef + experimental::re_strict + experimental::refaliasing experimental::regex_sets + experimental::signatures experimental::smartmatch + experimental::win32_perlio glob imprecision io @@ -27,8 +37,11 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( layer newline pipe + syscalls unopened + locale misc + missing numeric once overflow @@ -36,6 +49,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( portable recursion redefine + redundant regexp severe debugging @@ -59,6 +73,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( taint threads uninitialized + umask unpack untie utf8 @@ -66,18 +81,21 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( nonchar surrogate void + void_unusual y2k ); sub VERSION { - no warnings; - local $@; - if (defined $_[1] && eval { $_[0]->UNIVERSAL::VERSION($_[1]); 1}) { - $^H |= 0x20000 - unless _PERL_LT_5_8_4; - $^H{strictures_enable} = int $_[1]; + { + no warnings; + local $@; + if (defined $_[1] && eval { &UNIVERSAL::VERSION; 1}) { + $^H |= 0x20000 + unless _PERL_LT_5_8_4; + $^H{strictures_enable} = int $_[1]; + } } - goto &UNIVERSAL::VERSION; + _CAN_GOTO_VERSION ? goto &UNIVERSAL::VERSION : &UNIVERSAL::VERSION; } our %extra_load_states; @@ -125,18 +143,18 @@ sub _enable_1 { } } -our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } qw( - exec - recursion - internal - malloc - newline - experimental - deprecated - portable +our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } ( + 'exec', # not safe to catch + 'recursion', # will be caught by other mechanisms + 'internal', # not safe to catch + 'malloc', # not safe to catch + 'newline', # stat on nonexistent file with a newline in it + 'experimental', # no reason for these to be fatal + 'deprecated', # unfortunately can't make these fatal + 'portable', # everything worked fine here, just may not elsewhere ); -our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } qw( - once +our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } ( + 'once' # triggers inconsistently, can't be fatalized ); sub _enable_2 { @@ -144,7 +162,8 @@ sub _enable_2 { strict->import; warnings->import; warnings->import(FATAL => @WARNING_CATEGORIES); - warnings->import(NONFATAL => @V2_NONFATAL); + warnings->unimport(FATAL => @V2_NONFATAL); + warnings->import(@V2_NONFATAL); warnings->unimport(@V2_DISABLE); if (_want_extra($opts->{file})) { @@ -256,25 +275,8 @@ and when either C<.git>, C<.svn>, or C<.hg> is present in the current directory C<.git>, C<.svn>, or C<.hg> is present two directories up along with C (which would indicate we are in a C operation, via L) -- or when the C environment variable is -set, in which case - - use strictures 2; +set, in which case it also does the equivalent of -is equivalent to - - use strict; - use warnings FATAL => 'all'; - use warnings NONFATAL => qw( - exec - recursion - internal - malloc - newline - experimental - deprecated - portable - ); - no warnings 'once'; no indirect 'fatal'; no multidimensional; no bareword::filehandles; @@ -317,6 +319,54 @@ increase (e.g. 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of this code will result in a sub-version increase (e.g. 1.000000 to 1.000001 (1.0.1)). +=head1 CATEGORY SELECTIONS + +strictures does not enable fatal warnings for all categories. + +=over 4 + +=item exec + +Includes a warning that can cause your program to continue running +unintentionally after an internal fork. Not safe to fatalize. + +=item recursion + +Infinite recursion will end up overflowing the stack eventually anyway. + +=item internal + +Triggers deep within perl, in places that are not safe to trap. + +=item malloc + +Triggers deep within perl, in places that are not safe to trap. + +=item newline + +Includes a warning for using stat on a valid but suspect filename, ending in a +newline. + +=item experimental + +Experimental features are used intentionally. + +=item deprecated + +Deprecations will inherently be added to in the future in unexpected ways, +so making them fatal won't be reliable. + +=item portable + +Doesn't indicate an actual problem with the program, only that it may not +behave properly if run on a different machine. + +=item once + +Can't be fatalized. Also triggers very inconsistently, so we just disable it. + +=back + =head1 VERSIONS Depending on the version of strictures requested, different warnings will be @@ -335,12 +385,26 @@ Equivalent to: use strict; use warnings FATAL => 'all'; - use warnings NONFATAL => 'deprecated', 'experimental'; + use warnings NONFATAL => qw( + exec + recursion + internal + malloc + newline + experimental + deprecated + portable + ); + no warnings 'once'; + # and if in dev mode: no indirect 'fatal'; no multidimensional; no bareword::filehandles; +Additionally, any warnings created by modules using L or +C will not be fatalized. + =head2 VERSION 1 Equivalent to: