This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Integrate:
[perl5.git] / warnings.pl
diff --git a/warnings.pl b/warnings.pl
index 24246f5..f2380d9 100644 (file)
--- a/warnings.pl
+++ b/warnings.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-$VERSION = '1.02';
+$VERSION = '1.02_02';
 
 BEGIN {
   push @INC, './lib';
@@ -49,7 +49,6 @@ my $tree = {
                'misc'          => [ 5.008, DEFAULT_OFF],
                'regexp'        => [ 5.008, DEFAULT_OFF],
                'glob'          => [ 5.008, DEFAULT_OFF],
-               'y2k'           => [ 5.008, DEFAULT_OFF],
                'untie'         => [ 5.008, DEFAULT_OFF],
        'substr'        => [ 5.008, DEFAULT_OFF],
        'taint'         => [ 5.008, DEFAULT_OFF],
@@ -253,10 +252,13 @@ if (@ARGV && $ARGV[0] eq "tree")
 unlink "warnings.h";
 unlink "lib/warnings.pm";
 open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+binmode WARN;
 open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
+binmode PM;
 
 print WARN <<'EOM' ;
-/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+/* -*- buffer-read-only: t -*-
+   !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
    This file is built by warnings.pl
    Any changes made here will be lost!
 */
@@ -274,12 +276,15 @@ 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              (((STRLEN*)0)+1)    /* use warnings 'all' */
+#define pWARN_NONE             (((STRLEN*)0)+2)    /* no  warnings 'all' */
 
 #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 ;
@@ -314,78 +319,33 @@ 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';
 
 #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((U8 *)(c + 1), 2*(x)))
+#define isWARNf_on(c,x)        (IsSet((U8 *)(c + 1), 2*(x)+1))
+
+#define DUP_WARNINGS(p)                \
+    (STRLEN*)(specialWARN(p) ? (p)     \
+    : 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))
+#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)
@@ -401,7 +361,7 @@ print WARN <<'EOM';
              isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
 
 /* end of file warnings.h */
-
+/* ex: set ro: */
 EOM
 
 close WARN ;
@@ -464,10 +424,11 @@ while (<DATA>) {
     print PM $_ ;
 }
 
+print PM "# ex: set ro:\n";
 close PM ;
 
 __END__
-
+# -*- buffer-read-only: t -*-
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 # This file was created by warnings.pl
 # Any changes made here will be lost.
@@ -475,7 +436,7 @@ __END__
 
 package warnings;
 
-our $VERSION = '1.03';
+our $VERSION = '1.05';
 
 =head1 NAME
 
@@ -600,14 +561,14 @@ See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 
 =cut
 
-use Carp ();
-
 KEYWORDS
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
 sub Croaker
 {
+    require Carp::Heavy; # this initializes %CarpInternal
+    local $Carp::CarpInternal{'warnings'};
     delete $Carp::CarpInternal{'warnings'};
     Carp::croak(@_);
 }
@@ -781,6 +742,7 @@ sub warn
 
     my $message = pop ;
     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
+    require Carp;
     Carp::croak($message)
        if vec($callers_bitmask, $offset+1, 1) ||
           vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
@@ -800,6 +762,7 @@ sub warnif
                (vec($callers_bitmask, $offset, 1) ||
                vec($callers_bitmask, $Offsets{'all'}, 1)) ;
 
+    require Carp;
     Carp::croak($message)
        if vec($callers_bitmask, $offset+1, 1) ||
           vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
Unnamed repository; edit this file 'description' to name the repository.