The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
################################################################################
##
##  $Revision: 7 $
##  $Author: mhx $
##  $Date: 2010/03/07 13:15:44 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=provides

newSVpvn_share
__UNDEFINED__

=implementation

/* Hint: newSVpvn_share
 * The SVs created by this function only mimic the behaviour of
 * shared PVs without really being shared. Only use if you know
 * what you're doing.
 */

#ifndef newSVpvn_share

#if { NEED newSVpvn_share }

SV *
newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
  SV *sv;
  if (len < 0)
    len = -len;
  if (!hash)
    PERL_HASH(hash, (char*) src, len);
  sv = newSVpvn((char *) src, len);
  sv_upgrade(sv, SVt_PVIV);
  SvIVX(sv) = hash;
  SvREADONLY_on(sv);
  SvPOK_on(sv);
  return sv;
}

#endif

#endif

__UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv))

=xsinit

#define NEED_newSVpvn_share

=xsubs

int
newSVpvn_share()
	PREINIT:
		const char *s;
		SV *sv;
		STRLEN len;
		U32 hash;
	CODE:
		RETVAL = 0;
		s = "mhx";
		len = 3;
		PERL_HASH(hash, (char *) s, len);
		sv = newSVpvn_share(s, len, 0);
		s = 0;
		RETVAL += strEQ(SvPV_nolen_const(sv), "mhx");
		RETVAL += SvCUR(sv) == len;
		RETVAL += SvSHARED_HASH(sv) == hash;
		SvREFCNT_dec(sv);
		s = "foobar";
		len = 6;
		PERL_HASH(hash, (char *) s, len);
		sv = newSVpvn_share(s, -(I32) len, hash);
		s = 0;
		RETVAL += strEQ(SvPV_nolen_const(sv), "foobar");
		RETVAL += SvCUR(sv) == len;
		RETVAL += SvSHARED_HASH(sv) == hash;
		SvREFCNT_dec(sv);
	OUTPUT:
		RETVAL


=tests plan => 1

ok(&Devel::PPPort::newSVpvn_share(), 6);