vutil.h

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