X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warnings.pl;h=126597291ae42489af64821b31bc2ca66c3acde4;hb=943795c2b00ef89ec677d4af7a0a6bfabab5c916;hp=e3c04036690101884df64eadef99e08756adb5bb;hpb=37442d52629699d89ef62d315d35efbc0facec21;p=p5sagit%2Fp5-mst-13.2.git diff --git a/warnings.pl b/warnings.pl index e3c0403..1265972 100644 --- a/warnings.pl +++ b/warnings.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -$VERSION = '1.02'; +$VERSION = '1.02_02'; BEGIN { push @INC, './lib'; @@ -276,9 +276,9 @@ print WARN <<'EOM' ; #define G_WARN_ONCE 8 /* set if 'once' ever enabled */ #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) -#define pWARN_STD Nullsv -#define pWARN_ALL (Nullsv+1) /* use warnings 'all' */ -#define pWARN_NONE (Nullsv+2) /* no warnings 'all' */ +#define pWARN_STD NULL +#define pWARN_ALL (((SV*)0)+1) /* use warnings 'all' */ +#define pWARN_NONE (((SV*)0)+2) /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ (x) == pWARN_NONE) @@ -325,69 +325,23 @@ print WARN <<'EOM'; #define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) -#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x))) -#define isWARNf_on(c,x) (IsSet(SvPVX(c), 2*(x)+1)) - -#define ckWARN(x) \ - ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ - (PL_curcop->cop_warnings == pWARN_ALL || \ - isWARN_on(PL_curcop->cop_warnings, x) ) ) \ - || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) - -#define ckWARN2(x,y) \ - ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ - (PL_curcop->cop_warnings == pWARN_ALL || \ - isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) ) ) \ - || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) - -#define ckWARN3(x,y,z) \ - ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ - (PL_curcop->cop_warnings == pWARN_ALL || \ - isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) || \ - isWARN_on(PL_curcop->cop_warnings, z) ) ) \ - || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) - -#define ckWARN4(x,y,z,t) \ - ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ - (PL_curcop->cop_warnings == pWARN_ALL || \ - isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) || \ - isWARN_on(PL_curcop->cop_warnings, z) || \ - isWARN_on(PL_curcop->cop_warnings, t) ) ) \ - || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) - -#define ckWARN_d(x) \ - (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ - (PL_curcop->cop_warnings != pWARN_NONE && \ - isWARN_on(PL_curcop->cop_warnings, x) ) ) - -#define ckWARN2_d(x,y) \ - (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ - (PL_curcop->cop_warnings != pWARN_NONE && \ - (isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) ) ) ) - -#define ckWARN3_d(x,y,z) \ - (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ - (PL_curcop->cop_warnings != pWARN_NONE && \ - (isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) || \ - isWARN_on(PL_curcop->cop_warnings, z) ) ) ) - -#define ckWARN4_d(x,y,z,t) \ - (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ - (PL_curcop->cop_warnings != pWARN_NONE && \ - (isWARN_on(PL_curcop->cop_warnings, x) || \ - isWARN_on(PL_curcop->cop_warnings, y) || \ - isWARN_on(PL_curcop->cop_warnings, z) || \ - isWARN_on(PL_curcop->cop_warnings, t) ) ) ) - -#define packWARN(a) (a ) -#define packWARN2(a,b) ((a) | (b)<<8 ) -#define packWARN3(a,b,c) ((a) | (b)<<8 | (c) <<16 ) -#define packWARN4(a,b,c,d) ((a) | (b)<<8 | (c) <<16 | (d) <<24) +#define isWARN_on(c,x) (IsSet(SvPVX_const(c), 2*(x))) +#define isWARNf_on(c,x) (IsSet(SvPVX_const(c), 2*(x)+1)) + +#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w)) +#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2)) +#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3)) +#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4)) + +#define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w)) +#define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2)) +#define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3)) +#define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4)) + +#define packWARN(a) (a ) +#define packWARN2(a,b) ((a) | ((b)<<8) ) +#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) ) +#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24)) #define unpackWARN1(x) ((x) & 0xFF) #define unpackWARN2(x) (((x) >>8) & 0xFF) @@ -478,7 +432,7 @@ __END__ package warnings; -our $VERSION = '1.04'; +our $VERSION = '1.05'; =head1 NAME @@ -609,7 +563,8 @@ $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; sub Croaker { - require Carp; + require Carp::Heavy; # this initializes %CarpInternal + local $Carp::CarpInternal{'warnings'}; delete $Carp::CarpInternal{'warnings'}; Carp::croak(@_); }