X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=699a1e9084da030de9c148a67fe11e758926fbaa;hb=cc71ab2adc9ce111ca10a92f79c7252ee28dc7a6;hp=01ccd8c9ea4573abf72de89f9ee807359889f36f;hpb=c5b35ddf5761c3b17ae2f479f0099e13c27adfed;p=p5sagit%2Fstrictures.git diff --git a/lib/strictures.pm b/lib/strictures.pm index 01ccd8c..699a1e9 100644 --- a/lib/strictures.pm +++ b/lib/strictures.pm @@ -5,23 +5,32 @@ use warnings FATAL => 'all'; BEGIN { *_PERL_LT_5_8_4 = ($] < 5.008004) ? sub(){1} : sub(){0}; + # goto &UNIVERSAL::VERSION usually works on 5.8, but fails on some ARM + # machines. Seems to always work on 5.10 though. + *_CAN_GOTO_VERSION = ($] >= 5.010000) ? sub(){1} : sub(){0}; } -our $VERSION = '2.000000'; +our $VERSION = '2.000003'; $VERSION = eval $VERSION; our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( closure + chmod deprecated exiting experimental experimental::autoderef + experimental::bitwise + 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 @@ -32,7 +41,9 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( pipe syscalls unopened + locale misc + missing numeric once overflow @@ -40,6 +51,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( portable recursion redefine + redundant regexp severe debugging @@ -63,6 +75,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( taint threads uninitialized + umask unpack untie utf8 @@ -70,18 +83,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; @@ -90,7 +106,7 @@ our $Smells_Like_VCS; sub import { my $class = shift; - my %opts = ref $_[0] ? %{$_[0]} : @_; + my %opts = @_ == 1 ? %{$_[0]} : @_; if (!exists $opts{version}) { $opts{version} = exists $^H{strictures_enable} ? delete $^H{strictures_enable} @@ -148,7 +164,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})) { @@ -183,9 +200,9 @@ sub _want_extra { and $file =~ /^(?:t|xt|lib|blib)[\\\/]/ and defined $Smells_Like_VCS ? $Smells_Like_VCS : ( $Smells_Like_VCS = !!( - -e '.git' || -e '.svn' || -e '.hg' + -e '.git' || -e '.svn' || -e '.hg' || -e '.bzr' || (-e '../../dist.ini' - && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' )) + && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' || -e '../../.bzr' )) )) ); } @@ -229,7 +246,7 @@ EOE __END__ =head1 NAME -strictures - turn on strict and make all warnings fatal +strictures - turn on strict and make most warnings fatal =head1 SYNOPSIS @@ -255,30 +272,13 @@ except when called from a file which matches: (caller)[1] =~ /^(?:t|xt|lib|blib)[\\\/]/ -and when either C<.git>, C<.svn>, or C<.hg> is present in the current directory -(with the intention of only forcing extra tests on the author side) -- or when -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; +and when either C<.git>, C<.svn>, C<.hg>, or C<.bzr> is present in the current +directory (with the intention of only forcing extra tests on the author side) +-- or when C<.git>, C<.svn>, C<.hg>, or C<.bzr> 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 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; @@ -321,6 +321,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 @@ -339,12 +387,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: