Commit | Line | Data |
---|---|---|
8565c31a MHM |
1 | ################################################################################ |
2 | ## | |
b2049988 | 3 | ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
8565c31a MHM |
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 | ||
c8799aff | 14 | __UNDEFINED__ |
8565c31a MHM |
15 | |
16 | =implementation | |
17 | ||
dca7d424 P |
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 | |
94e22bd6 MH |
20 | #endif |
21 | ||
c8799aff N |
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)) | |
dca7d424 | 29 | |
8565c31a MHM |
30 | __UNDEFINED__ GvSVn(gv) GvSV(gv) |
31 | __UNDEFINED__ isGV_with_GP(gv) isGV(gv) | |
49ef49fe CBW |
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) | |
94e22bd6 MH |
35 | __UNDEFINED__ gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE) |
36 | ||
8565c31a MHM |
37 | =xsubs |
38 | ||
39 | int | |
40 | GvSVn() | |
b2049988 MHM |
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 | |
8565c31a MHM |
52 | |
53 | int | |
54 | isGV_with_GP() | |
b2049988 MHM |
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 | |
8565c31a | 70 | |
49ef49fe CBW |
71 | int |
72 | get_cvn_flags() | |
b2049988 MHM |
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 | |
49ef49fe CBW |
85 | |
86 | SV* | |
87 | gv_fetchpvn_flags() | |
b2049988 | 88 | CODE: |
94e22bd6 | 89 | RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSIONFAKE", sizeof("Devel::PPPort::VERSIONFAKE")-5, 0, SVt_PV)); |
b2049988 MHM |
90 | OUTPUT: |
91 | RETVAL | |
49ef49fe CBW |
92 | |
93 | SV* | |
94 | gv_fetchsv(name) | |
b2049988 MHM |
95 | SV *name |
96 | CODE: | |
97 | RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV)); | |
98 | OUTPUT: | |
99 | RETVAL | |
8565c31a | 100 | |
94e22bd6 MH |
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 | |
8565c31a | 119 | |
8154c0b1 | 120 | is(Devel::PPPort::GvSVn(), 1); |
8565c31a | 121 | |
8154c0b1 | 122 | is(Devel::PPPort::isGV_with_GP(), 2); |
49ef49fe | 123 | |
8154c0b1 | 124 | is(Devel::PPPort::get_cvn_flags(), 3); |
49ef49fe | 125 | |
8154c0b1 | 126 | is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION); |
49ef49fe | 127 | |
8154c0b1 | 128 | is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION); |
94e22bd6 | 129 | |
8154c0b1 | 130 | is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check"); |
94e22bd6 | 131 | ok($::{sanity_check}); |