X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warnings.pl;h=4168c5871a13582c14ec2da6fd5d87d33491df8a;hb=024963f8e0e4bfbd631d6878a69f86cabc760a32;hp=853a04a1a748ce14b567a2632bf747aa17652c12;hpb=72dc9ed5af65c946f73050becea29207a1af86c1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/warnings.pl b/warnings.pl index 853a04a..4168c58 100644 --- a/warnings.pl +++ b/warnings.pl @@ -61,7 +61,6 @@ my $tree = { 'pack' => [ 5.008, DEFAULT_OFF], 'unpack' => [ 5.008, DEFAULT_OFF], 'threads' => [ 5.008, DEFAULT_OFF], - 'assertions' => [ 5.009, DEFAULT_OFF], #'default' => [ 5.008, DEFAULT_ON ], }], @@ -282,6 +281,9 @@ print WARN <<'EOM' ; #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ (x) == pWARN_NONE) + +/* if PL_warnhook is set to this value, then warnings die */ +#define PERL_WARNHOOK_FATAL (&PL_sv_placeholder) EOM my $offset = 0 ; @@ -316,9 +318,6 @@ print WARN tab(5, '#define WARNsize'), "$warn_size\n" ; #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ; print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ; print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ; -my $WARN_TAINTstring = mkOct($warn_size, map $_ * 2, @{ $list{'taint'} }); - -print WARN tab(5, '#define WARN_TAINTstring'), qq["$WARN_TAINTstring"\n] ; print WARN <<'EOM'; @@ -329,8 +328,9 @@ print WARN <<'EOM'; #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) #define DUP_WARNINGS(p) \ - specialWARN(p) ? (p) \ - : CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, char) + (specialWARN(p) ? (STRLEN*)(p) \ + : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \ + char)) #define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w)) #define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2)) @@ -436,7 +436,14 @@ __END__ package warnings; -our $VERSION = '1.05'; +our $VERSION = '1.06'; + +# Verify that we're called correctly so that warnings will work. +# see also strict.pm. +unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { + my (undef, $f, $l) = caller; + die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); +} =head1 NAME