-#!perl -T
+#!perl
use strict;
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 + 3;
+
+BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
use lib 't/lib';
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;
is $@, '', 'RT #47902';
}
+# This test may not fail for the old version when ran in taint mode
+{
+ my $err = eval <<' SNIP';
+ use indirect::TestRequired4::a0;
+ indirect::TestRequired4::a0::error();
+ SNIP
+ like $err, qr/^Can't locate object method "new" via package "X"/, 'RT #50570';
+}
+
+# This test must be in the topmost scope
+BEGIN { eval 'use indirect::TestRequired5::a0' }
+my $err = indirect::TestRequired5::a0::error();
+like $err, qr/^Can't locate object method "new" via package "X"/,
+ 'identifying requires by their eval context pointer is not enough';
+
__DATA__
my $a = new P1;