Turn on CvCLONE for all anonymous subs passed as hooks

So that they're cloned later, which seems to fix some strange issues that arose with a5339a6ced4d5e3ad1541320476c3d6bf8ff9408 when the default callbacks were no longer capturing an external pad (which used to make them eligible for cloning).

This fixes RT #47902.

diff --git a/MANIFEST b/MANIFEST
index cab1db467fe424c41ffbe7680c3d80d00b8c2bb5..1bf2e07965f6f644c6768f11eb3554e421ac8fe0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -25,5 +25,7 @@ t/95-portability-files.t
 t/99-kwalitee.t
 t/lib/indirect/Test0/Fffff/Vvvvvvv.pm
 t/lib/indirect/Test0/Oooooo/Pppppppp.pm
+t/lib/indirect/Test1/il1.pm
+t/lib/indirect/Test1/il2.pm
 t/lib/indirect/TestRequired1.pm
 t/lib/indirect/TestRequired2.pm

diff --git a/indirect.xs b/indirect.xs
index 57e78e1c315cce3273b2089a0909b28e401297a6..8e6c789b1b0098315650bf8b05193aac0eb0c77e 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -35,6 +35,10 @@
 # define SvPVX_const SvPVX
 #endif
 
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN SvREFCNT_inc
+#endif
+
 #ifndef sv_catpvn_nomg
 # define sv_catpvn_nomg sv_catpvn
 #endif
@@ -260,12 +264,21 @@ STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
 STATIC SV *indirect_tag(pTHX_ SV *value) {
 #define indirect_tag(V) indirect_tag(aTHX_ (V))
  indirect_hint_t *h;
+ SV *code = NULL;
  dMY_CXT;
 
- value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL;
+ if (SvOK(value) && SvROK(value)) {
+  value = SvRV(value);
+  if (SvTYPE(value) >= SVt_PVCV) {
+   code = value;
+   if (CvANON(code) && !CvCLONED(code))
+    CvCLONE_on(code);
+   SvREFCNT_inc_simple_NN(code);
+  }
+ }
 
  h = PerlMemShared_malloc(sizeof *h);
- h->code = SvREFCNT_inc(value);
+ h->code = code;
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
  {

diff --git a/t/30-scope.t b/t/30-scope.t
index fffaad9f5b8d7e17d30ff14fe20c595d5a9ff740..2b937f78fc63882e8df604ecef21626e1a0569d6 100644 (file)
--- a/t/30-scope.t
+++ b/t/30-scope.t
@@ -6,7 +6,7 @@ use warnings;
 my $tests;
 BEGIN { $tests = 18 }
 
-use Test::More tests => 1 + $tests + 1 + 2 + 3 + 5;
+use Test::More tests => 1 + $tests + 1 + 2 + 3 + 5 + 1;
 
 use lib 't/lib';
 
@@ -104,6 +104,16 @@ sub expect {
  is_deeply \@w, [ ],           'second require test doesn\'t have more errors';
 }
 
+{
+ eval <<' SNIP';
+  return;
+  no indirect ':fatal';
+  use indirect::Test1::il1 ();
+  use indirect::Test1::il2 ();
+ SNIP
+ is $@, '', 'RT #47902';
+}
+
 __DATA__
 my $a = new P1;
 

diff --git a/t/lib/indirect/Test1/il1.pm b/t/lib/indirect/Test1/il1.pm
new file mode 100644 (file)
index 0000000..ac5c0e3
--- /dev/null
+++ b/t/lib/indirect/Test1/il1.pm
@@ -0,0 +1,3 @@
+no indirect ":fatal";
+
+1;

diff --git a/t/lib/indirect/Test1/il2.pm b/t/lib/indirect/Test1/il2.pm
new file mode 100644 (file)
index 0000000..ae83265
--- /dev/null
+++ b/t/lib/indirect/Test1/il2.pm
@@ -0,0 +1,3 @@
+package indirect::Test1::il2;
+import indirect::Test1::il2;
+1;