ext/Devel/PPPort/parts/inc/pvs

   1 ################################################################################
   2 ##
   3 ##  $Revision: 3 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2006/05/22 12:27:50 +0200 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004-2006, 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__  sv_catpvs(sv, str)          sv_catpvn(sv, str "", sizeof(str) - 1)
  33 __UNDEFINED__  sv_setpvs(sv, str)          sv_setpvn(sv, str "", sizeof(str) - 1)
  34 __UNDEFINED__  hv_fetchs(hv, key, lval)    hv_fetch(hv, key "", sizeof(key) - 1, lval)
  35 __UNDEFINED__  hv_stores(hv, key, val)     hv_store(hv, key "", sizeof(key) - 1, val, 0)
  36
  37 =xsubs
  38
  39 void
  40 newSVpvs()
  41         PPCODE:
  42                 XPUSHs(newSVpvs("newSVpvs"));
  43                 XSRETURN(1);
  44
  45 void
  46 sv_catpvs(sv)
  47         SV *sv
  48         PPCODE:
  49                 sv_catpvs(sv, "sv_catpvs");
  50
  51 void
  52 sv_setpvs(sv)
  53         SV *sv
  54         PPCODE:
  55                 sv_setpvs(sv, "sv_setpvs");
  56
  57 void
  58 hv_fetchs(hv)
  59         SV *hv
  60         PREINIT:
  61                 SV **s;
  62         PPCODE:
  63                 s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
  64                 XPUSHs(sv_mortalcopy(*s));
  65                 XSRETURN(1);
  66
  67 void
  68 hv_stores(hv, sv)
  69         SV *hv
  70         SV *sv
  71         PPCODE:
  72                 hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv));
  73
  74 =tests plan => 7
  75
  76 my $x = 'foo';
  77
  78 ok(Devel::PPPort::newSVpvs(), "newSVpvs");
  79
  80 Devel::PPPort::sv_catpvs($x);
  81 ok($x, "foosv_catpvs");
  82
  83 Devel::PPPort::sv_setpvs($x);
  84 ok($x, "sv_setpvs");
  85
  86 my %h = ('hv_fetchs' => 42);
  87 Devel::PPPort::hv_stores(\%h, 4711);
  88 ok(scalar keys %h, 2);
  89 ok(exists $h{'hv_stores'});
  90 ok($h{'hv_stores'}, 4711);
  91 ok(Devel::PPPort::hv_fetchs(\%h), 42);