dist/Devel-PPPort/parts/inc/shared_pv

   1 ################################################################################
   2 ##
   3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
   4 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
   5 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
   6 ##
   7 ##  This program is free software; you can redistribute it and/or
   8 ##  modify it under the same terms as Perl itself.
   9 ##
  10 ################################################################################
  11
  12 =provides
  13
  14 newSVpvn_share
  15 __UNDEFINED__
  16
  17 =implementation
  18
  19 /* Hint: newSVpvn_share
  20  * The SVs created by this function only mimic the behaviour of
  21  * shared PVs without really being shared. Only use if you know
  22  * what you're doing.
  23  */
  24
  25 #ifndef newSVpvn_share
  26
  27 #if { NEED newSVpvn_share }
  28
  29 SV *
  30 newSVpvn_share(pTHX_ const char *s, I32 len, U32 hash)
  31 {
  32   SV *sv;
  33   if (len < 0)
  34     len = -len;
  35   if (!hash)
  36     PERL_HASH(hash, (char*) s, len);
  37   sv = newSVpvn((char *) s, 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 is(&Devel::PPPort::newSVpvn_share(), 6);