Use the hint pointer as the unique identifier for the %^H entry
authorVincent Pit <vince@profvince.com>
Thu, 27 Aug 2009 22:14:08 +0000 (00:14 +0200)
committerVincent Pit <vince@profvince.com>
Thu, 27 Aug 2009 22:32:52 +0000 (00:32 +0200)
The previous solution (using the callback CV) could cause pragma leaks if
you specified the same "hook" (i.e. a reference to the same sub) in two
different require scopes.

MANIFEST
indirect.xs
t/30-scope.t
t/lib/indirect/TestRequired3X.pm [new file with mode: 0644]
t/lib/indirect/TestRequired3Y.pm [new file with mode: 0644]

index 5090e23..f3f597d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -30,3 +30,5 @@ t/lib/indirect/Test1/il1.pm
 t/lib/indirect/Test1/il2.pm
 t/lib/indirect/TestRequired1.pm
 t/lib/indirect/TestRequired2.pm
+t/lib/indirect/TestRequired3X.pm
+t/lib/indirect/TestRequired3Y.pm
index 8f673e1..00622a5 100644 (file)
@@ -302,10 +302,10 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
 
  /* We only need for the key to be an unique tag for looking up the value later.
   * Allocated memory provides convenient unique identifiers, so that's why we
-  * use the value pointer as the key itself. */
- ptable_hints_store(MY_CXT.tbl, value, h);
+  * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
 
- return newSViv(PTR2IV(value));
+ return newSViv(PTR2IV(h));
 }
 
 STATIC SV *indirect_detag(pTHX_ const SV *hint) {
index 78b2b1d..ad4abc8 100644 (file)
@@ -6,7 +6,7 @@ use warnings;
 my $tests;
 BEGIN { $tests = 18 }
 
-use Test::More tests => (1 + $tests + 1) + 3 + 3 + 3 + 5 + 1;
+use Test::More tests => (1 + $tests + 1) + 3 + 3 + 3 + 5 + 4 + 1;
 
 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
 
@@ -117,6 +117,32 @@ sub expect {
  is_deeply \@w, [ ],           'second require test doesn\'t have more errors';
 }
 
+{
+ local @main::new;
+ my (@err, @w);
+ sub cb3 { push @err, $_[0] };
+ local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
+ eval <<' TESTREQUIRED3';
+  {
+   package indirect::TestRequired3Z;
+   sub new { push @main::new, __PACKAGE__ }
+   no indirect hook => \&main::cb3;
+   use indirect::TestRequired3X;
+   use indirect::TestRequired3Y;
+   new indirect::TestRequired3Z;
+  }
+ TESTREQUIRED3
+ @w = grep !/^warn:Attempt\s+to\s+free\s+unreferenced/, @w if $] <= 5.008003;
+ is        $@,          '',
+           "pragma leak when reusing callback test doesn't croak prematurely";
+ is_deeply \@w,         [ ],
+           "pragma leak when reusing callback test doesn't warn";
+ is_deeply \@err,       [ map "indirect::TestRequired3$_", qw/X Z/ ],
+           "pragma leak when reusing callback test caught the right errors";
+ is_deeply \@main::new, [ map "indirect::TestRequired3$_", qw/X Y Z/ ],
+           "pragma leak when reusing callback test ran the three constructors";
+}
+
 {
  eval <<' SNIP';
   return;
diff --git a/t/lib/indirect/TestRequired3X.pm b/t/lib/indirect/TestRequired3X.pm
new file mode 100644 (file)
index 0000000..1b26ed3
--- /dev/null
@@ -0,0 +1,7 @@
+package indirect::TestRequired3X;
+
+sub new { push @main::new, __PACKAGE__ }
+
+no indirect hook => \&main::cb3;
+
+new indirect::TestRequired3X;
diff --git a/t/lib/indirect/TestRequired3Y.pm b/t/lib/indirect/TestRequired3Y.pm
new file mode 100644 (file)
index 0000000..9fdec64
--- /dev/null
@@ -0,0 +1,5 @@
+package indirect::TestRequired3Y;
+
+sub new { push @main::new, __PACKAGE__ }
+
+new indirect::TestRequired3Y;