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
39int
40GvSVn()
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
53int
54isGV_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
71int
72get_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
86SV*
87gv_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
93SV*
94gv_fetchsv(name)
95        SV *name
96        CODE:
97                RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV));
98        OUTPUT:
99                RETVAL
100
101void
102gv_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
120is(Devel::PPPort::GvSVn(), 1);
121
122is(Devel::PPPort::isGV_with_GP(), 2);
123
124is(Devel::PPPort::get_cvn_flags(), 3);
125
126is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
127
128is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
129
130is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
131ok($::{sanity_check});
132