From: Nicholas Clark Date: Sun, 12 Nov 2006 21:57:22 +0000 (+0000) Subject: Forgot to add the new files for 29248. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3e8ab2efa5fcca2b79cbec10285bd352ea5cf4ad;p=p5sagit%2Fp5-mst-13.2.git Forgot to add the new files for 29248. p4raw-id: //depot/perl@29249 --- diff --git a/ext/XS/APItest/core.c b/ext/XS/APItest/core.c new file mode 100644 index 0000000..39192b0 --- /dev/null +++ b/ext/XS/APItest/core.c @@ -0,0 +1,2 @@ +#define PERL_CORE +#include "core_or_not.inc" diff --git a/ext/XS/APItest/core_or_not.inc b/ext/XS/APItest/core_or_not.inc new file mode 100644 index 0000000..0824764 --- /dev/null +++ b/ext/XS/APItest/core_or_not.inc @@ -0,0 +1,43 @@ +/* This code is compiled twice, once with -DPERL_CORE defined, once without */ + +#include "EXTERN.h" +#include "perl.h" + +#ifdef PERL_CORE +# define SUFFIX core +#else +# define SUFFIX notcore +#endif + +bool +CAT2(sv_setsv_cow_hashkey_, SUFFIX) (pTHX) { + SV *source = newSVpvn_share("pie", 3, 0); + SV *destination = newSV(0); + bool result; + + if(!SvREADONLY(source) && !SvFAKE(source)) { + SvREFCNT_dec(source); + croak ("Creating a shared hash key scalar failed when " + STRINGIFY(SUFFIX) " got flags %"UVxf, (UV)SvFLAGS(source)); + } + + sv_setsv(destination, source); + + result = SvREADONLY(destination) && SvFAKE(destination); + + SvREFCNT_dec(source); + SvREFCNT_dec(destination); + + return result; +} + +/* + * Local variables: + * mode: c + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */ diff --git a/ext/XS/APItest/notcore.c b/ext/XS/APItest/notcore.c new file mode 100644 index 0000000..9e19d8a --- /dev/null +++ b/ext/XS/APItest/notcore.c @@ -0,0 +1,2 @@ +#undef PERL_CORE +#include "core_or_not.inc" diff --git a/ext/XS/APItest/t/svsetsv.t b/ext/XS/APItest/t/svsetsv.t new file mode 100644 index 0000000..0d938f8 --- /dev/null +++ b/ext/XS/APItest/t/svsetsv.t @@ -0,0 +1,25 @@ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { + print "1..0 # Skip: XS::APItest was not built\n"; + exit 0; + } +} + +use strict; +use warnings; + +use Test::More tests => 3; + +BEGIN { use_ok('XS::APItest') }; + +# I can't see a good way to easily get back perl-space diagnostics for these +# I hope that this isn't a problem. +ok(sv_setsv_cow_hashkey_core, + "With PERL_CORE sv_setsv does COW for shared hash key scalars"); + +ok(!sv_setsv_cow_hashkey_notcore, + "Without PERL_CORE sv_setsv doesn't COW for shared hash key scalars");