Turn on CvCLONE for all anonymous subs passed as hooks rt47902
authorVincent Pit <vince@profvince.com>
Wed, 15 Jul 2009 16:15:42 +0000 (18:15 +0200)
committerVincent Pit <vince@profvince.com>
Wed, 15 Jul 2009 16:15:42 +0000 (18:15 +0200)
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.

MANIFEST
indirect.xs
t/30-scope.t
t/lib/indirect/Test1/il1.pm [new file with mode: 0644]
t/lib/indirect/Test1/il2.pm [new file with mode: 0644]

index cab1db4..1bf2e07 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
index 57e78e1..8e6c789 100644 (file)
 # 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
  {
index fffaad9..2b937f7 100644 (file)
@@ -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
@@ -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
@@ -0,0 +1,3 @@
+package indirect::Test1::il2;
+import indirect::Test1::il2;
+1;