ext/Devel/PPPort/parts/inc/shared_pv

   1 ################################################################################
   2 ##
   3 ##  $Revision: 4 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2008/01/04 10:47:40 +0100 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004-2008, 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 #ifndef newSVpvn_share
  26
  27 #if { NEED newSVpvn_share }
  28
  29 SV *
  30 newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
  31 {
  32   SV *sv;
  33   if (len < 0)
  34     len = -len;
  35   if (!hash)
  36     PERL_HASH(hash, (char*) src, len);
  37   sv = newSVpvn((char *) src, len);
  38   sv_upgrade(sv, SVt_PVIV);
  39   SvIVX(sv) = hash;
  40   SvREADONLY_on(sv);
  41   SvPOK_on(sv);
  42   return sv;
  43 }
  44
  45 #endif
  46
  47 #endif
  48
  49 __UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv))
  50
  51 =xsinit
  52
  53 #define NEED_newSVpvn_share
  54
  55 =xsubs
  56
  57 int
  58 newSVpvn_share()
  59         PREINIT:
  60                 const char *s;
  61                 SV *sv;
  62                 STRLEN len;
  63                 U32 hash;
  64         CODE:
  65                 RETVAL = 0;
  66                 s = "mhx";
  67                 len = 3;
  68                 PERL_HASH(hash, (char *) s, len);
  69                 sv = newSVpvn_share(s, len, 0);
  70                 s = 0;
  71                 RETVAL += strEQ(SvPV_nolen_const(sv), "mhx");
  72                 RETVAL += SvCUR(sv) == len;
  73                 RETVAL += SvSHARED_HASH(sv) == hash;
  74                 SvREFCNT_dec(sv);
  75                 s = "foobar";
  76                 len = 6;
  77                 PERL_HASH(hash, (char *) s, len);
  78                 sv = newSVpvn_share(s, -(I32) len, hash);
  79                 s = 0;
  80                 RETVAL += strEQ(SvPV_nolen_const(sv), "foobar");
  81                 RETVAL += SvCUR(sv) == len;
  82                 RETVAL += SvSHARED_HASH(sv) == hash;
  83                 SvREFCNT_dec(sv);
  84         OUTPUT:
  85                 RETVAL
  86
  87
  88 =tests plan => 1
  89
  90 ok(&Devel::PPPort::newSVpvn_share(), 6);
  91