Forgot to add the new files for 29248.

p4raw-id: //depot/perl@29249

4 files changed, 72 insertions, 0 deletions

diff --git a/ext/XS/APItest/core.c b/ext/XS/APItest/core.c
new file mode 100644
index 0000000000..39192b01a7
--- /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 0000000000..082476418c
--- /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 0000000000..9e19d8a14b
--- /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 0000000000..0d938f8d58
--- /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");