cpan/Devel-PPPort/parts/inc/pvs

   1 ################################################################################
   2 ##
   3 ##  $Revision: 14 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2010/03/07 13:15:45 +0100 $
   6 ##
   7 ################################################################################
   8 ##
   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.
  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)
  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)
  38
  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
  42 __UNDEFINED__  get_cvs(name, flags)                     get_cvn_flags(name "", sizeof(name)-1, flags)
  43
  44 =xsinit
  45
  46 #define NEED_newSVpvn_share
  47
  48 =xsubs
  49
  50 void
  51 newSVpvs()
  52         PPCODE:
  53                 mXPUSHs(newSVpvs("newSVpvs"));
  54                 XSRETURN(1);
  55
  56 void
  57 newSVpvs_flags()
  58         PPCODE:
  59                 XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
  60                 XSRETURN(1);
  61
  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
  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:
 105                 (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
 106
 107 SV*
 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
 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
 135
 136
 137 =tests plan => 12
 138
 139 my $x = 'foo';
 140
 141 ok(Devel::PPPort::newSVpvs(), "newSVpvs");
 142 ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
 143 ok(Devel::PPPort::newSVpvs_share(), 3);
 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);
 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);