summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.fnc2
-rw-r--r--embed.h2
-rw-r--r--pod/perlintern.pod7
-rw-r--r--proto.h2
-rw-r--r--util.c52
-rw-r--r--warnings.h64
-rw-r--r--warnings.pl64
7 files changed, 82 insertions, 111 deletions
diff --git a/embed.fnc b/embed.fnc
index b820cae4d2..88a977283f 100644
--- 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 0c1bb8beb5..cc55a37c7e 100644
--- a/embed.h
+++ b/embed.h
@@ -3619,6 +3619,8 @@
#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)
diff --git a/pod/perlintern.pod b/pod/perlintern.pod
index b4b6ed7577..3baecb45de 100644
--- a/pod/perlintern.pod
+++ b/pod/perlintern.pod
@@ -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 00e9c50d6b..fb8bc8a352 100644
--- 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 c65ccce82f..6ef7a0175f 100644
--- 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)
diff --git a/warnings.h b/warnings.h
index a5ca60f6f1..27e240e9d5 100644
--- a/warnings.h
+++ b/warnings.h
@@ -88,61 +88,15 @@
#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) )
diff --git a/warnings.pl b/warnings.pl
index 1f14fde86c..bc6b42a37a 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -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) )
View Lorry Controller Status