ext/Devel-PPPort/parts/inc/pvs

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