1 ################################################################################
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.
7 ## This program is free software; you can redistribute it and/or
8 ## modify it under the same terms as Perl itself.
10 ################################################################################
18 /* concatenating with "" ensures that only literal strings are accepted as argument
19 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
20 * under some configurations might be macros
23 __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
25 __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
26 __UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
27 __UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
28 __UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
29 __UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
30 __UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
31 __UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
33 __UNDEFINED__ gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
34 __UNDEFINED__ gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
36 __UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
40 #define NEED_newSVpvn_share
47 mXPUSHs(newSVpvs("newSVpvs"));
53 XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
63 PERL_HASH(hash, "pvs", 3);
64 sv = newSVpvs_share("pvs");
65 RETVAL += strEQ(SvPV_nolen_const(sv), "pvs");
66 RETVAL += SvCUR(sv) == 3;
67 RETVAL += SvSHARED_HASH(sv) == hash;
76 sv_catpvs(sv, "sv_catpvs");
82 sv_setpvs(sv, "sv_setpvs");
90 s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
91 XPUSHs(sv_mortalcopy(*s));
99 (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
104 RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV));
111 RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0));
121 xv = get_cvs("Devel::PPPort::foobar", 0);
122 if(xv == NULL) RETVAL++;
123 xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI);
124 if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
125 xv = get_cvs("Devel::PPPort::get_cvs", 0);
126 if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
135 is(Devel::PPPort::newSVpvs(), "newSVpvs");
136 is(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
137 is(Devel::PPPort::newSVpvs_share(), 3);
139 Devel::PPPort::sv_catpvs($x);
140 is($x, "foosv_catpvs");
142 Devel::PPPort::sv_setpvs($x);
145 my %h = ('hv_fetchs' => 42);
146 Devel::PPPort::hv_stores(\%h, 4711);
147 is(scalar keys %h, 2);
148 ok(exists $h{'hv_stores'});
149 is($h{'hv_stores'}, 4711);
150 is(Devel::PPPort::hv_fetchs(\%h), 42);
151 is(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
152 is(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
154 is(Devel::PPPort::get_cvs(), 3);