This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Import vutil.h from the CPAN version dist
[perl5.git] / vutil.h
1 #include "ppport.h"
2
3 /* The MUTABLE_*() macros cast pointers to the types shown, in such a way
4  * (compiler permitting) that casting away const-ness will give a warning;
5  * e.g.:
6  *
7  * const SV *sv = ...;
8  * AV *av1 = (AV*)sv;        <== BAD:  the const has been silently cast away
9  * AV *av2 = MUTABLE_AV(sv); <== GOOD: it may warn
10  */
11
12 #ifndef MUTABLE_PTR
13 #  if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
14 #    define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
15 #  else
16 #    define MUTABLE_PTR(p) ((void *) (p))
17 #  endif
18
19 #  define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p))
20 #  define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p))
21 #  define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p))
22 #  define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p))
23 #  define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p))
24 #  define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
25 #endif
26
27 #ifndef SvPVx_nolen_const
28 #  if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
29 #    define SvPVx_nolen_const(sv) ({SV *_sv = (sv); SvPV_nolen_const(_sv); })
30 #  else
31 #    define SvPVx_nolen_const(sv) (SvPV_nolen_const(sv))
32 #  endif
33 #endif
34
35 #ifndef PERL_ARGS_ASSERT_CK_WARNER
36 static void Perl_ck_warner(pTHX_ U32 err, const char* pat, ...);
37
38 #  ifdef vwarner
39 static
40 void
41 Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
42 {
43   va_list args;
44
45   PERL_UNUSED_ARG(err);
46   if (ckWARN(err)) {
47     va_list args;
48     va_start(args, pat);
49     vwarner(err, pat, &args);
50     va_end(args);
51   }
52 }
53 #  else
54 /* yes this replicates my_warner */
55 static
56 void
57 Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
58 {
59   SV *sv;
60   va_list args;
61
62   PERL_UNUSED_ARG(err);
63
64   va_start(args, pat);
65   sv = vnewSVpvf(pat, &args);
66   va_end(args);
67   sv_2mortal(sv);
68   warn("%s", SvPV_nolen(sv));
69 }
70 #  endif
71 #endif
72
73 #define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
74 #define PERL_DECIMAL_VERSION \
75         PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
76 #define PERL_VERSION_LT(r,v,s) \
77         (PERL_DECIMAL_VERSION < PERL_VERSION_DECIMAL(r,v,s))
78 #define PERL_VERSION_GE(r,v,s) \
79         (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
80
81 #define ISA_CLASS_OBJ(v,c) (sv_isobject(v) && sv_derived_from(v,c))
82
83 #if PERL_VERSION_GE(5,9,0)
84
85 #  define VUTIL_REPLACE_CORE 1
86
87 const char * Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv);
88 SV * Perl_new_version2(pTHX_ SV *ver);
89 SV * Perl_upg_version2(pTHX_ SV *sv, bool qv);
90 SV * Perl_vstringify2(pTHX_ SV *vs);
91 SV * Perl_vverify2(pTHX_ SV *vs);
92 SV * Perl_vnumify2(pTHX_ SV *vs);
93 SV * Perl_vnormal2(pTHX_ SV *vs);
94 SV * Perl_vstringify2(pTHX_ SV *vs);
95 int Perl_vcmp2(pTHX_ SV *lsv, SV *rsv);
96 const char * Perl_prescan_version2(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha);
97
98 #  define SCAN_VERSION(a,b,c)   Perl_scan_version2(aTHX_ a,b,c)
99 #  define NEW_VERSION(a)        Perl_new_version2(aTHX_ a)
100 #  define UPG_VERSION(a,b)      Perl_upg_version2(aTHX_ a, b)
101 #  define VSTRINGIFY(a)         Perl_vstringify2(aTHX_ a)
102 #  define VVERIFY(a)            Perl_vverify2(aTHX_ a)
103 #  define VNUMIFY(a)            Perl_vnumify2(aTHX_ a)
104 #  define VNORMAL(a)            Perl_vnormal2(aTHX_ a)
105 #  define VCMP(a,b)             Perl_vcmp2(aTHX_ a,b)
106 #  define PRESCAN_VERSION(a,b,c,d,e,f,g)        Perl_prescan_version2(aTHX_ a,b,c,d,e,f,g)
107 #  define is_LAX_VERSION(a,b) \
108         (a != Perl_prescan_version2(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL))
109 #  define is_STRICT_VERSION(a,b) \
110         (a != Perl_prescan_version2(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL))
111
112 #else
113
114 const char * Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv);
115 SV * Perl_new_version(pTHX_ SV *ver);
116 SV * Perl_upg_version(pTHX_ SV *sv, bool qv);
117 SV * Perl_vverify(pTHX_ SV *vs);
118 SV * Perl_vnumify(pTHX_ SV *vs);
119 SV * Perl_vnormal(pTHX_ SV *vs);
120 SV * Perl_vstringify(pTHX_ SV *vs);
121 int Perl_vcmp(pTHX_ SV *lsv, SV *rsv);
122 const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha);
123
124 #  define SCAN_VERSION(a,b,c)   Perl_scan_version(aTHX_ a,b,c)
125 #  define NEW_VERSION(a)        Perl_new_version(aTHX_ a)
126 #  define UPG_VERSION(a,b)      Perl_upg_version(aTHX_ a, b)
127 #  define VSTRINGIFY(a)         Perl_vstringify(aTHX_ a)
128 #  define VVERIFY(a)            Perl_vverify(aTHX_ a)
129 #  define VNUMIFY(a)            Perl_vnumify(aTHX_ a)
130 #  define VNORMAL(a)            Perl_vnormal(aTHX_ a)
131 #  define VCMP(a,b)             Perl_vcmp(aTHX_ a,b)
132
133 #  define PRESCAN_VERSION(a,b,c,d,e,f,g)        Perl_prescan_version(aTHX_ a,b,c,d,e,f,g)
134 #  define is_LAX_VERSION(a,b) \
135         (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL))
136 #  define is_STRICT_VERSION(a,b) \
137         (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL))
138
139 #endif
140
141 #if PERL_VERSION_LT(5,11,4)
142 #  define BADVERSION(a,b,c) \
143         if (b) { \
144             *b = c; \
145         } \
146         return a;
147
148 #  define PERL_ARGS_ASSERT_PRESCAN_VERSION      \
149         assert(s); assert(sqv); assert(ssaw_decimal);\
150         assert(swidth); assert(salpha);
151
152 #  define PERL_ARGS_ASSERT_SCAN_VERSION \
153         assert(s); assert(rv)
154 #  define PERL_ARGS_ASSERT_NEW_VERSION  \
155         assert(ver)
156 #  define PERL_ARGS_ASSERT_UPG_VERSION  \
157         assert(ver)
158 #  define PERL_ARGS_ASSERT_VVERIFY      \
159         assert(vs)
160 #  define PERL_ARGS_ASSERT_VNUMIFY      \
161         assert(vs)
162 #  define PERL_ARGS_ASSERT_VNORMAL      \
163         assert(vs)
164 #  define PERL_ARGS_ASSERT_VSTRINGIFY   \
165         assert(vs)
166 #  define PERL_ARGS_ASSERT_VCMP \
167         assert(lhv); assert(rhv)
168 #  define PERL_ARGS_ASSERT_CK_WARNER      \
169         assert(pat)
170 #endif