dist/Devel-PPPort/parts/inc/gv

   1 ################################################################################
   2 ##
   3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
   4 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
   5 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
   6 ##
   7 ##  This program is free software; you can redistribute it and/or
   8 ##  modify it under the same terms as Perl itself.
   9 ##
  10 ################################################################################
  11
  12 =provides
  13
  14 __UNDEFINED__
  15
  16 =implementation
  17
  18 #if { VERSION >= 5.9.2 } && { VERSION <= 5.9.3 } /* 5.9.2 and 5.9.3 ignore the length param */
  19 #undef gv_fetchpvn_flags
  20 #endif
  21
  22 #ifdef GV_NOADD_MASK
  23 #  define D_PPP_GV_NOADD_MASK  GV_NOADD_MASK
  24 #else
  25 #  define D_PPP_GV_NOADD_MASK  0xE0
  26 #endif
  27
  28 __UNDEFINED__ gv_fetchpvn_flags(name, len, flags, sv_type) gv_fetchpv(SvPVX(sv_2mortal(newSVpvn((name), (len)))), ((flags) & D_PPP_GV_NOADD_MASK) ? FALSE : TRUE, (I32)(sv_type))
  29
  30 __UNDEFINED__ GvSVn(gv)        GvSV(gv)
  31 __UNDEFINED__ isGV_with_GP(gv) isGV(gv)
  32 __UNDEFINED__ gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
  33
  34 __UNDEFINED__ get_cvn_flags(name, namelen, flags) get_cv(name, flags)
  35 __UNDEFINED__ gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
  36
  37 =xsubs
  38
  39 int
  40 GvSVn()
  41         PREINIT:
  42                 GV* gv;
  43         CODE:
  44                 RETVAL = 0;
  45                 gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
  46                 if (GvSVn(gv) != NULL)
  47                 {
  48                   RETVAL++;
  49                 }
  50         OUTPUT:
  51                 RETVAL
  52
  53 int
  54 isGV_with_GP()
  55         PREINIT:
  56                 GV* gv;
  57         CODE:
  58                 RETVAL = 0;
  59                 gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
  60                 if (isGV_with_GP(gv))
  61                 {
  62                   RETVAL++;
  63                 }
  64                 if (!isGV(&PL_sv_undef))
  65                 {
  66                   RETVAL++;
  67                 }
  68         OUTPUT:
  69                 RETVAL
  70
  71 int
  72 get_cvn_flags()
  73         PREINIT:
  74                 CV* xv;
  75         CODE:
  76                 RETVAL = 0;
  77                 xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, 0);
  78                 if(xv == NULL) RETVAL++;
  79                 xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, GV_ADDMULTI);
  80                 if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
  81                 xv = get_cvn_flags("Devel::PPPort::get_cvn_flags", sizeof("Devel::PPPort::get_cvn_flags")-1, 0);
  82                 if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
  83         OUTPUT:
  84                 RETVAL
  85
  86 SV*
  87 gv_fetchpvn_flags()
  88         CODE:
  89                 RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSIONFAKE", sizeof("Devel::PPPort::VERSIONFAKE")-5, 0, SVt_PV));
  90         OUTPUT:
  91                 RETVAL
  92
  93 SV*
  94 gv_fetchsv(name)
  95         SV *name
  96         CODE:
  97                 RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV));
  98         OUTPUT:
  99                 RETVAL
 100
 101 void
 102 gv_init_type(namesv, multi, flags)
 103     SV* namesv
 104     int multi
 105     I32 flags
 106     PREINIT:
 107         HV *defstash = gv_stashpv("main", 0);
 108         STRLEN len;
 109         const char * const name = SvPV_const(namesv, len);
 110         GV *gv = *(GV**)hv_fetch(defstash, name, len, TRUE);
 111     PPCODE:
 112         if (SvTYPE(gv) == SVt_PVGV)
 113             Perl_croak(aTHX_ "GV is already a PVGV");
 114         if (multi) flags |= GV_ADDMULTI;
 115         gv_init_pvn(gv, defstash, name, len, flags);
 116         XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
 117
 118 =tests plan => 7
 119
 120 is(Devel::PPPort::GvSVn(), 1);
 121
 122 is(Devel::PPPort::isGV_with_GP(), 2);
 123
 124 is(Devel::PPPort::get_cvn_flags(), 3);
 125
 126 is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
 127
 128 is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
 129
 130 is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
 131 ok($::{sanity_check});