X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F42-threads-global.t;fp=t%2F42-threads-global.t;h=c2c4d83f7e2906e58e511bb3a198b4eca2b98d2f;hp=0000000000000000000000000000000000000000;hb=57da6be33e154ebfd9f3fa41ca0beb0c95568ce0;hpb=5cc9cb534a3573afabe6a4c009de680a58d34cd4 diff --git a/t/42-threads-global.t b/t/42-threads-global.t new file mode 100644 index 0000000..c2c4d83 --- /dev/null +++ b/t/42-threads-global.t @@ -0,0 +1,41 @@ +#!perl -T + +use strict; +use warnings; + +use lib 't/lib'; +use indirect::TestThreads; + +use Test::Leaner; + +sub expect { + my ($pkg) = @_; + qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/; +} + +my $error; + +no indirect 'global', 'hook' => sub { $error = indirect::msg(@_) }; + +sub try { + my $tid = threads->tid(); + + for my $run (1 .. 2) { + my $desc = "global indirect hook (thread $tid, run $run)"; + my $class = "Mango$tid"; + my @warns; + { + local $SIG{__WARN__} = sub { push @warns, @_ }; + eval "return; my \$x = new $class 1, 2;" + } + is $@, '', "$desc: did not croak"; + is_deeply \@warns, [ ], "$desc: no warnings"; + like $error, expect($class), "$desc: correct error"; + } +} + +my @threads = map spawn(\&try), 1 .. 10; + +$_->join for @threads; + +done_testing(scalar(@threads) * 3 * 2);