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
14gv_fetchpvn_flags
15
16=implementation
17
18#ifndef gv_fetchpvn_flags
19#if { NEED gv_fetchpvn_flags }
20
21GV*
22gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, int flags, int types) {
23	char *namepv = savepvn(name, len);
24	GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
25	Safefree(namepv);
26	return stash;
27}
28
29#endif
30#endif
31
32__UNDEFINED__ GvSVn(gv)        GvSV(gv)
33__UNDEFINED__ isGV_with_GP(gv) isGV(gv)
34__UNDEFINED__ gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
35
36__UNDEFINED__ get_cvn_flags(name, namelen, flags) get_cv(name, flags)
37__UNDEFINED__ gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
38
39=xsinit
40
41#define NEED_gv_fetchpvn_flags
42
43=xsubs
44
45int
46GvSVn()
47        PREINIT:
48                GV* gv;
49        CODE:
50                RETVAL = 0;
51                gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
52                if (GvSVn(gv) != NULL)
53                {
54                  RETVAL++;
55                }
56        OUTPUT:
57                RETVAL
58
59int
60isGV_with_GP()
61        PREINIT:
62                GV* gv;
63        CODE:
64                RETVAL = 0;
65                gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV);
66                if (isGV_with_GP(gv))
67                {
68                  RETVAL++;
69                }
70                if (!isGV(&PL_sv_undef))
71                {
72                  RETVAL++;
73                }
74        OUTPUT:
75                RETVAL
76
77int
78get_cvn_flags()
79        PREINIT:
80                CV* xv;
81        CODE:
82                RETVAL = 0;
83                xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, 0);
84                if(xv == NULL) RETVAL++;
85                xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, GV_ADDMULTI);
86                if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
87                xv = get_cvn_flags("Devel::PPPort::get_cvn_flags", sizeof("Devel::PPPort::get_cvn_flags")-1, 0);
88                if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
89        OUTPUT:
90                RETVAL
91
92SV*
93gv_fetchpvn_flags()
94        CODE:
95#if { VERSION < 5.9.2 } || { VERSION > 5.9.3 } /* 5.9.2 and 5.9.3 ignore the length param */
96                RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSIONFAKE", sizeof("Devel::PPPort::VERSIONFAKE")-5, 0, SVt_PV));
97#else
98                RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSION", 0, 0, SVt_PV));
99#endif
100        OUTPUT:
101                RETVAL
102
103SV*
104gv_fetchsv(name)
105        SV *name
106        CODE:
107                RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV));
108        OUTPUT:
109                RETVAL
110
111void
112gv_init_type(namesv, multi, flags)
113    SV* namesv
114    int multi
115    I32 flags
116    PREINIT:
117        HV *defstash = gv_stashpv("main", 0);
118        STRLEN len;
119        const char * const name = SvPV_const(namesv, len);
120        GV *gv = *(GV**)hv_fetch(defstash, name, len, TRUE);
121    PPCODE:
122        if (SvTYPE(gv) == SVt_PVGV)
123            Perl_croak(aTHX_ "GV is already a PVGV");
124        if (multi) flags |= GV_ADDMULTI;
125        gv_init_pvn(gv, defstash, name, len, flags);
126	XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
127
128=tests plan => 7
129
130ok(Devel::PPPort::GvSVn(), 1);
131
132ok(Devel::PPPort::isGV_with_GP(), 2);
133
134ok(Devel::PPPort::get_cvn_flags(), 3);
135
136ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
137
138ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
139
140ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
141ok($::{sanity_check});
142