cpan/Devel-PPPort/parts/inc/shared_pv

   1 ################################################################################
   2 ##
   3 ##  $Revision: 7 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2010/03/07 13:15:44 +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 newSVpvn_share
  21 __UNDEFINED__
  22
  23 =implementation
  24
  25 /* Hint: newSVpvn_share
  26  * The SVs created by this function only mimic the behaviour of
  27  * shared PVs without really being shared. Only use if you know
  28  * what you're doing.
  29  */
  30
  31 #ifndef newSVpvn_share
  32
  33 #if { NEED newSVpvn_share }
  34
  35 SV *
  36 newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
  37 {
  38   SV *sv;
  39   if (len < 0)
  40     len = -len;
  41   if (!hash)
  42     PERL_HASH(hash, (char*) src, len);
  43   sv = newSVpvn((char *) src, len);
  44   sv_upgrade(sv, SVt_PVIV);
  45   SvIVX(sv) = hash;
  46   SvREADONLY_on(sv);
  47   SvPOK_on(sv);
  48   return sv;
  49 }
  50
  51 #endif
  52
  53 #endif
  54
  55 __UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv))
  56
  57 =xsinit
  58
  59 #define NEED_newSVpvn_share
  60
  61 =xsubs
  62
  63 int
  64 newSVpvn_share()
  65         PREINIT:
  66                 const char *s;
  67                 SV *sv;
  68                 STRLEN len;
  69                 U32 hash;
  70         CODE:
  71                 RETVAL = 0;
  72                 s = "mhx";
  73                 len = 3;
  74                 PERL_HASH(hash, (char *) s, len);
  75                 sv = newSVpvn_share(s, len, 0);
  76                 s = 0;
  77                 RETVAL += strEQ(SvPV_nolen_const(sv), "mhx");
  78                 RETVAL += SvCUR(sv) == len;
  79                 RETVAL += SvSHARED_HASH(sv) == hash;
  80                 SvREFCNT_dec(sv);
  81                 s = "foobar";
  82                 len = 6;
  83                 PERL_HASH(hash, (char *) s, len);
  84                 sv = newSVpvn_share(s, -(I32) len, hash);
  85                 s = 0;
  86                 RETVAL += strEQ(SvPV_nolen_const(sv), "foobar");
  87                 RETVAL += SvCUR(sv) == len;
  88                 RETVAL += SvSHARED_HASH(sv) == hash;
  89                 SvREFCNT_dec(sv);
  90         OUTPUT:
  91                 RETVAL
  92
  93
  94 =tests plan => 1
  95
  96 ok(&Devel::PPPort::newSVpvn_share(), 6);
  97