1 ################################################################################
5 ## $Date: 2010/03/07 13:15:45 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz.
10 ## Version 2.x, Copyright (C) 2001, Paul Marquess.
11 ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
13 ## This program is free software; you can redistribute it and/or
14 ## modify it under the same terms as Perl itself.
16 ################################################################################
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
29 __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
31 __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
32 __UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
33 __UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
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)
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)
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)
42 __UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
46 #define NEED_newSVpvn_share
53 mXPUSHs(newSVpvs("newSVpvs"));
59 XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
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;
82 sv_catpvs(sv, "sv_catpvs");
88 sv_setpvs(sv, "sv_setpvs");
96 s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
97 XPUSHs(sv_mortalcopy(*s));
105 (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
110 RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV));
117 RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 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++;
141 ok(Devel::PPPort::newSVpvs(), "newSVpvs");
142 ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
143 ok(Devel::PPPort::newSVpvs_share(), 3);
145 Devel::PPPort::sv_catpvs($x);
146 ok($x, "foosv_catpvs");
148 Devel::PPPort::sv_setpvs($x);
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);
157 ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
158 ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
160 ok(Devel::PPPort::get_cvs(), 3);