This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
replace ckWARN macros with functions
authorDave Mitchell <davem@fdisolutions.com>
Sat, 2 Jul 2005 15:05:04 +0000 (15:05 +0000)
committerDave Mitchell <davem@fdisolutions.com>
Sat, 2 Jul 2005 15:05:04 +0000 (15:05 +0000)
p4raw-id: //depot/perl@25050

embed.fnc
embed.h
pod/perlintern.pod
proto.h
util.c
warnings.h
warnings.pl

index b820cae..88a9772 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1524,6 +1524,8 @@ p |void   |dump_sv_child  |SV *sv
 #ifdef PERL_DONT_CREATE_GVSV
 Ap     |GV*    |gv_SVadd       |NN GV* gv
 #endif
+po     |bool   |ckwarn         |U32 w
+po     |bool   |ckwarn_d       |U32 w
 
 p      |void   |offer_nice_chunk       |NN void *chunk|U32 chunk_size
 
diff --git a/embed.h b/embed.h
index 0c1bb8b..cc55a37 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define gv_SVadd(a)            Perl_gv_SVadd(aTHX_ a)
 #endif
 #ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
 #define offer_nice_chunk(a,b)  Perl_offer_nice_chunk(aTHX_ a,b)
 #endif
 #define ck_anoncode(a)         Perl_ck_anoncode(aTHX_ a)
index b4b6ed7..3baecb4 100644 (file)
@@ -224,7 +224,12 @@ Found in file pad.h
 =item PAD_SET_CUR      
 
 Set the current pad to be pad C<n> in the padlist, saving
-the previous current pad.
+the previous current pad. NB currently this macro expands to a string too
+long for some compilers, so it's best to replace it with
+
+    SAVECOMPPAD();
+    PAD_SET_CUR_NOSAVE(padlist,n);
+
 
        void    PAD_SET_CUR     (PADLIST padlist, I32 n)
 
diff --git a/proto.h b/proto.h
index 00e9c50..fb8bc8a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2995,6 +2995,8 @@ PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV* gv)
                        __attribute__nonnull__(pTHX_1);
 
 #endif
+PERL_CALLCONV bool     Perl_ckwarn(pTHX_ U32 w);
+PERL_CALLCONV bool     Perl_ckwarn_d(pTHX_ U32 w);
 
 PERL_CALLCONV void     Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
                        __attribute__nonnull__(pTHX_1);
diff --git a/util.c b/util.c
index c65ccce..6ef7a01 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1376,6 +1376,58 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     }
 }
 
+/* implements the ckWARN? macros */
+
+bool
+Perl_ckwarn(pTHX_ U32 w)
+{
+    return
+       (
+              isLEXWARN_on
+           && PL_curcop->cop_warnings != pWARN_NONE
+           && (
+                  PL_curcop->cop_warnings == pWARN_ALL
+               || isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
+               || (unpackWARN2(w) &&
+                    isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
+               || (unpackWARN3(w) &&
+                    isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
+               || (unpackWARN4(w) &&
+                    isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
+               )
+       )
+       ||
+       (
+           isLEXWARN_off && PL_dowarn & G_WARN_ON
+       )
+       ;
+}
+
+/* implements the ckWARN?_d macro */
+
+bool
+Perl_ckwarn_d(pTHX_ U32 w)
+{
+    return
+          isLEXWARN_off
+       || PL_curcop->cop_warnings == pWARN_ALL
+       || (
+             PL_curcop->cop_warnings != pWARN_NONE 
+          && (
+                  isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
+             || (unpackWARN2(w) &&
+                  isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
+             || (unpackWARN3(w) &&
+                  isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
+             || (unpackWARN4(w) &&
+                  isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
+             )
+          )
+       ;
+}
+
+
+
 /* since we've already done strlen() for both nam and val
  * we can use that info to make things faster than
  * sprintf(s, "%s=%s", nam, val)
index a5ca60f..27e240e 100644 (file)
 #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(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 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)                         )
index 1f14fde..bc6b42a 100644 (file)
@@ -328,61 +328,15 @@ print WARN <<'EOM';
 #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(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 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)                         )