X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=64d4ba2ed0666e2e5bba605a21d0971ed4464d88;hb=cf342065e3ce9c25aa15281e7ba4a6fbe3f26925;hp=85ea622c7d6fd75797a20ade34d9ab5387728b37;hpb=23c0b85d1580eb07a49da0096e4913debc21e8fa;p=p5sagit%2Fstrictures.git diff --git a/lib/strictures.pm b/lib/strictures.pm index 85ea622..64d4ba2 100644 --- a/lib/strictures.pm +++ b/lib/strictures.pm @@ -5,20 +5,33 @@ 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.000004'; $VERSION = eval $VERSION; our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( closure + chmod deprecated exiting experimental + experimental::autoderef + experimental::bitwise + experimental::const_attr + experimental::declared_refs 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 +40,11 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( layer newline pipe + syscalls unopened + locale misc + missing numeric once overflow @@ -36,6 +52,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( portable recursion redefine + redundant regexp severe debugging @@ -59,6 +76,7 @@ our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( taint threads uninitialized + umask unpack untie utf8 @@ -66,18 +84,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; @@ -86,7 +107,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} @@ -125,18 +146,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 +165,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})) { @@ -179,9 +201,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' )) )) ); } @@ -225,34 +247,39 @@ EOE __END__ =head1 NAME -strictures - turn on strict and make all warnings fatal +strictures - turn on strict and make most warnings fatal =head1 SYNOPSIS - use strictures 1; + use strictures 2; is equivalent to use strict; use warnings FATAL => 'all'; + use warnings NONFATAL => qw( + exec + recursion + internal + malloc + newline + experimental + deprecated + portable + ); + no warnings 'once'; 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 1; - -is equivalent to +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 - use strict; - use warnings FATAL => 'all'; no indirect 'fatal'; no multidimensional; no bareword::filehandles; @@ -295,20 +322,109 @@ 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)). -If the behaviour of C in normal mode changes in any way, that -will constitute a major version increase -- and the code already checks -when its version is tested to ensure that +=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. - use strictures 1; +=item portable -will continue to only introduce the current set of strictures even if 2.0 is -installed. +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 +enabled. If no specific version is requested, the current version's behavior +will be used. Versions can be requested using perl's standard mechanism: + + use strictures 2; + +Or, by passing in a C option: + + use strictures version => 2; + +=head2 VERSION 2 + +Equivalent to: + + use strict; + use warnings FATAL => 'all'; + 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: + + use strict; + use warnings FATAL => 'all'; + # and if in dev mode: + no indirect 'fatal'; + no multidimensional; + no bareword::filehandles; =head1 METHODS =head2 import -This method does the setup work described above in L +This method does the setup work described above in L. Optionally +accepts a C option to request a specific version's behavior. =head2 VERSION