X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F30-scope.t;h=ad4abc88d591af67b37dcacd862093c49c1829b2;hp=78b2b1dad86ba8fcfbe8e881f06ad79401cdec19;hb=c07766a234204d78a80b6d75534e03ae3465b6f3;hpb=28c424672aa75950b69186b3a7bee3f93b4a580a

diff --git a/t/30-scope.t b/t/30-scope.t
index 78b2b1d..ad4abc8 100644
--- 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) + 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;