X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warning.pl;h=400fc7e569d1147f7ff5881d4fd711caf771c45c;hb=6170680bfd1817febf6b13f65734e3e2e6e3f9bf;hp=497630de2859ea0e1aae4fa7f324cfeabe6084ba;hpb=599cee73f2261c5e09cde7ceba3f9a896989e117;p=p5sagit%2Fp5-mst-13.2.git diff --git a/warning.pl b/warning.pl index 497630d..400fc7e 100644 --- a/warning.pl +++ b/warning.pl @@ -1,5 +1,8 @@ #!/usr/bin/perl +BEGIN { + push @INC, './lib'; +} use strict ; sub DEFAULT_ON () { 1 } @@ -29,6 +32,10 @@ my $tree = { 'deprecated' => DEFAULT_OFF, 'printf' => DEFAULT_OFF, }, + 'severe' => { 'inplace' => DEFAULT_ON, + 'internal' => DEFAULT_ON, + 'debugging' => DEFAULT_ON, + }, 'void' => DEFAULT_OFF, 'recursion' => DEFAULT_OFF, 'redefine' => DEFAULT_OFF, @@ -36,7 +43,7 @@ my $tree = { 'uninitialized'=> DEFAULT_OFF, 'once' => DEFAULT_OFF, 'misc' => DEFAULT_OFF, - 'default' => DEFAULT_ON, + #'default' => DEFAULT_ON, } ; @@ -59,8 +66,8 @@ sub walk my @list = () ; my ($k, $v) ; - while (($k, $v) = each %$tre) { - + foreach $k (sort keys %$tre) { + $v = $tre->{$k}; die "duplicate key $k\n" if defined $list{$k} ; $Value{$index} = uc $k ; push @{ $list{$k} }, $index ++ ; @@ -70,7 +77,6 @@ sub walk } return @list ; - } ########################################################################### @@ -128,62 +134,62 @@ print WARN <<'EOM' ; */ -#define Off(x) ((x) / 8) -#define Bit(x) (1 << ((x) % 8)) +#define Off(x) ((x) / 8) +#define Bit(x) (1 << ((x) % 8)) #define IsSet(a, x) ((a)[Off(x)] & Bit(x)) + #define G_WARN_OFF 0 /* $^W == 0 */ -#define G_WARN_ON 1 /* $^W != 0 */ +#define G_WARN_ON 1 /* -w flag and $^W != 0 */ #define G_WARN_ALL_ON 2 /* -W flag */ #define G_WARN_ALL_OFF 4 /* -X flag */ +#define G_WARN_ONCE 8 /* set if 'once' ever enabled */ #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) -#if 1 +#define WARN_STD Nullsv +#define WARN_ALL (&PL_sv_yes) /* use warning 'all' */ +#define WARN_NONE (&PL_sv_no) /* no warning 'all' */ -/* Part of the logic below assumes that WARN_NONE is NULL */ +#define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ + (x) == WARN_NONE) #define ckDEAD(x) \ - (curcop->cop_warnings != WARN_ALL && \ - curcop->cop_warnings != WARN_NONE && \ - IsSet(SvPVX(curcop->cop_warnings), 2*x+1)) + ( ! specialWARN(PL_curcop->cop_warnings) && \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1)) #define ckWARN(x) \ - ( (curcop->cop_warnings && \ - (curcop->cop_warnings == WARN_ALL || \ - IsSet(SvPVX(curcop->cop_warnings), 2*x) ) ) \ - || (PL_dowarn & G_WARN_ON) ) + ( (PL_curcop->cop_warnings != WARN_STD && \ + PL_curcop->cop_warnings != WARN_NONE && \ + (PL_curcop->cop_warnings == WARN_ALL || \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) \ + || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) ) #define ckWARN2(x,y) \ - ( (curcop->cop_warnings && \ - (curcop->cop_warnings == WARN_ALL || \ - IsSet(SvPVX(curcop->cop_warnings), 2*x) || \ - IsSet(SvPVX(curcop->cop_warnings), 2*y) ) ) \ - || (PL_dowarn & G_WARN_ON) ) - -#else - -#define ckDEAD(x) \ - (curcop->cop_warnings != WARN_ALL && \ - curcop->cop_warnings != WARN_NONE && \ - SvPVX(curcop->cop_warnings)[Off(2*x+1)] & Bit(2*x+1) ) - -#define ckWARN(x) \ - ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \ - curcop->cop_warnings && \ - ( curcop->cop_warnings == WARN_ALL || \ - SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x) ) ) ) - -#define ckWARN2(x,y) \ - ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \ - curcop->cop_warnings && \ - ( curcop->cop_warnings == WARN_ALL || \ - SvPVX(curcop->cop_warnings)[Off(2*x)] & Bit(2*x) || \ - SvPVX(curcop->cop_warnings)[Off(2*y)] & Bit(2*y) ) ) ) - -#endif - -#define WARN_NONE NULL -#define WARN_ALL (&sv_yes) + ( (PL_curcop->cop_warnings != WARN_STD && \ + PL_curcop->cop_warnings != WARN_NONE && \ + (PL_curcop->cop_warnings == WARN_ALL || \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) \ + || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) ) + +#define ckWARN_d(x) \ + (PL_curcop->cop_warnings == WARN_STD || \ + PL_curcop->cop_warnings == WARN_ALL || \ + (PL_curcop->cop_warnings != WARN_NONE && \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) + +#define ckWARN2_d(x,y) \ + (PL_curcop->cop_warnings == WARN_STD || \ + PL_curcop->cop_warnings == WARN_ALL || \ + (PL_curcop->cop_warnings != WARN_NONE && \ + (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \ + IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) ) + + +#define isLEXWARN_on (PL_curcop->cop_warnings != WARN_STD) +#define isLEXWARN_off (PL_curcop->cop_warnings == WARN_STD) +#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) +#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x))) EOM @@ -262,36 +268,22 @@ package warning; =head1 NAME -warning - Perl pragma to control +warning - Perl pragma to control optional warnings =head1 SYNOPSIS use warning; + no warning; use warning "all"; - use warning "deprecated"; - - use warning; - no warning "unsafe"; + no warning "all"; =head1 DESCRIPTION -If no import list is supplied, all possible restrictions are assumed. -(This is the safest mode to operate in, but is sometimes too strict for -casual programming.) Currently, there are three possible things to be -strict about: - -=over 6 - -=item C - -This generates a runtime error if you use deprecated - - use warning 'deprecated'; - -=back +If no import list is supplied, all possible warnings are either enabled +or disabled. -See L. +See L and L. =cut