Commit | Line | Data |
f2ab5a41 |
1 | ################################################################################ |
2 | ## |
bfc37ff7 |
3 | ## $Revision: 14 $ |
f2ab5a41 |
4 | ## $Author: mhx $ |
bfc37ff7 |
5 | ## $Date: 2010/03/07 13:15:45 +0100 $ |
f2ab5a41 |
6 | ## |
7 | ################################################################################ |
8 | ## |
bfc37ff7 |
9 | ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz. |
f2ab5a41 |
10 | ## Version 2.x, Copyright (C) 2001, Paul Marquess. |
11 | ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
12 | ## |
13 | ## This program is free software; you can redistribute it and/or |
14 | ## modify it under the same terms as Perl itself. |
15 | ## |
16 | ################################################################################ |
17 | |
18 | =provides |
19 | |
20 | __UNDEFINED__ |
21 | |
22 | =implementation |
23 | |
24 | /* concatenating with "" ensures that only literal strings are accepted as argument |
25 | * note that STR_WITH_LEN() can't be used as argument to macros or functions that |
26 | * under some configurations might be macros |
27 | */ |
28 | |
29 | __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) |
30 | |
31 | __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) |
c1a049cb |
32 | __UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) |
bfc37ff7 |
33 | __UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0) |
f2ab5a41 |
34 | __UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) |
35 | __UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) |
c07deaaf |
36 | __UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) |
37 | __UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) |
f2ab5a41 |
38 | |
8565c31a |
39 | __UNDEFINED__ gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt) |
40 | __UNDEFINED__ gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags) |
41 | |
bfc37ff7 |
42 | __UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags) |
43 | |
44 | =xsinit |
45 | |
46 | #define NEED_newSVpvn_share |
47 | |
f2ab5a41 |
48 | =xsubs |
49 | |
50 | void |
51 | newSVpvs() |
52 | PPCODE: |
c1a049cb |
53 | mXPUSHs(newSVpvs("newSVpvs")); |
54 | XSRETURN(1); |
55 | |
56 | void |
57 | newSVpvs_flags() |
58 | PPCODE: |
59 | XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); |
f2ab5a41 |
60 | XSRETURN(1); |
61 | |
bfc37ff7 |
62 | int |
63 | newSVpvs_share() |
64 | PREINIT: |
65 | SV *sv; |
66 | U32 hash; |
67 | CODE: |
68 | RETVAL = 0; |
69 | PERL_HASH(hash, "pvs", 3); |
70 | sv = newSVpvs_share("pvs"); |
71 | RETVAL += strEQ(SvPV_nolen_const(sv), "pvs"); |
72 | RETVAL += SvCUR(sv) == 3; |
73 | RETVAL += SvSHARED_HASH(sv) == hash; |
74 | SvREFCNT_dec(sv); |
75 | OUTPUT: |
76 | RETVAL |
77 | |
f2ab5a41 |
78 | void |
79 | sv_catpvs(sv) |
80 | SV *sv |
81 | PPCODE: |
82 | sv_catpvs(sv, "sv_catpvs"); |
83 | |
84 | void |
85 | sv_setpvs(sv) |
86 | SV *sv |
87 | PPCODE: |
88 | sv_setpvs(sv, "sv_setpvs"); |
89 | |
90 | void |
91 | hv_fetchs(hv) |
92 | SV *hv |
93 | PREINIT: |
94 | SV **s; |
95 | PPCODE: |
96 | s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); |
97 | XPUSHs(sv_mortalcopy(*s)); |
98 | XSRETURN(1); |
99 | |
100 | void |
101 | hv_stores(hv, sv) |
102 | SV *hv |
103 | SV *sv |
104 | PPCODE: |
c58e738a |
105 | (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv)); |
f2ab5a41 |
106 | |
8565c31a |
107 | SV* |
8565c31a |
108 | gv_fetchpvs() |
109 | CODE: |
110 | RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV)); |
111 | OUTPUT: |
112 | RETVAL |
113 | |
114 | SV* |
115 | gv_stashpvs() |
116 | CODE: |
117 | RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0)); |
118 | OUTPUT: |
119 | RETVAL |
120 | |
bfc37ff7 |
121 | int |
122 | get_cvs() |
123 | PREINIT: |
124 | CV* xv; |
125 | CODE: |
126 | RETVAL = 0; |
127 | xv = get_cvs("Devel::PPPort::foobar", 0); |
128 | if(xv == NULL) RETVAL++; |
129 | xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI); |
130 | if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; |
131 | xv = get_cvs("Devel::PPPort::get_cvs", 0); |
132 | if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; |
133 | OUTPUT: |
134 | RETVAL |
8565c31a |
135 | |
bfc37ff7 |
136 | |
137 | =tests plan => 12 |
f2ab5a41 |
138 | |
139 | my $x = 'foo'; |
140 | |
141 | ok(Devel::PPPort::newSVpvs(), "newSVpvs"); |
c1a049cb |
142 | ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); |
bfc37ff7 |
143 | ok(Devel::PPPort::newSVpvs_share(), 3); |
f2ab5a41 |
144 | |
145 | Devel::PPPort::sv_catpvs($x); |
146 | ok($x, "foosv_catpvs"); |
147 | |
148 | Devel::PPPort::sv_setpvs($x); |
149 | ok($x, "sv_setpvs"); |
150 | |
151 | my %h = ('hv_fetchs' => 42); |
152 | Devel::PPPort::hv_stores(\%h, 4711); |
153 | ok(scalar keys %h, 2); |
154 | ok(exists $h{'hv_stores'}); |
155 | ok($h{'hv_stores'}, 4711); |
156 | ok(Devel::PPPort::hv_fetchs(\%h), 42); |
bfc37ff7 |
157 | ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); |
158 | ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); |
159 | |
160 | ok(Devel::PPPort::get_cvs(), 3); |