From: Vincent Pit <vince@profvince.com>
Date: Wed, 15 Jul 2009 16:42:10 +0000 (+0200)
Subject: Freshen t/30-scope.t
X-Git-Tag: v0.17~5
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=efb7ebf910d324ec6f2dcd1fd7e6650b23a5dac7

Freshen t/30-scope.t
---

diff --git a/t/30-scope.t b/t/30-scope.t
index 2b937f7..14b987c 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 + 2 + 3 + 5 + 1;
+use Test::More tests => (1 + $tests + 1) + 3 + 3 + 3 + 5 + 1;
 
 use lib 't/lib';
 
@@ -14,13 +14,14 @@ my %wrong = map { $_ => 1 } 2, 3, 5, 7, 9, 10, 14, 15, 17, 18;
 
 sub expect {
  my ($pkg, $file) = @_;
- $file = $file ? quotemeta $file : '\(eval\s+\d+\)';
- return qr/^warn:Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"\s+at\s+$file\s+line\s+\d+/;
+ $file = $file ? quotemeta $file : '\(eval \d+\)';
+ qr/^warn:Indirect call of method "new" on object "$pkg" at $file line \d+/;
 }
 
 {
  my $code = do { local $/; <DATA> };
  my (%res, $num, @left);
+
  {
   local $SIG{__WARN__} = sub {
    ++$num;
@@ -31,65 +32,75 @@ sub expect {
     push @left, "[$num] $w";
    }
   };
-  eval "die qq{ok\\n}; $code";
-  is($@, "ok\n", 'DATA compiled fine');
+  eval "return; $code";
  }
+ is $@, '', 'DATA compiled fine';
+
  for (1 .. $tests) {
   my $w = $res{$_};
   if ($wrong{$_}) {
-   like($w, expect("P$_"), "$_ should warn");
+   like $w, expect("P$_"), "$_ should warn";
   } else {
-   is($w, undef, "$_ shouldn't warn");
+   is   $w, undef,         "$_ shouldn't warn";
   }
  }
- is(@left, 0, 'nothing left');
+
+ is @left, 0, 'nothing left';
  diag "Extraneous warnings:\n", @left if @left;
 }
 
 {
- my $w = '';
- local $SIG{__WARN__} = sub {
-  $w = 'more than 2 warnings' if $w;
-  $w = join '', 'warn:', @_
- };
+ my @w;
  {
-  eval 'no indirect; my $x = new Foo';
-  like($w, expect('Foo'), "eval 'no indirect; my \$x = new Foo'");
+  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
+  eval 'return; no indirect; my $x = new Foo';
  }
- $w = '';
+ is   $@,    '',            "eval 'no indirect; my \$x = new Foo'";
+ is   @w,    1,             'got one warning';
+ diag join "\n", 'All warnings:', @w if @w > 1;
+ like $w[0], expect('Foo'), 'correct warning';
+}
+
+{
+ my @w;
  {
+  local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
   {
    no indirect;
-   eval 'my $x = new Bar';
-  }
-  if ($] < 5.009005) {
-   is($w, '', "eval 'no indirect; my \$x = new Bar'");
-  } else {
-   like($w, expect('Bar'), "no indirect; eval 'my \$x = new Bar'");
+   eval 'return; my $x = new Bar';
   }
  }
+ is $@, '', "no indirect; eval 'my \$x = new Bar'";
+ if ($] < 5.009005) {
+  is   @w,   0,              'no warnings caught';
+  pass 'placeholder';
+ } else {
+  is   @w,    1,             'got one warning';
+  diag join "\n", 'All warnings:', @w if @w > 1;
+  like $w[0], expect('Bar'), 'correct warning';
+ }
 }
 
 {
  my @w;
  {
   local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
-  eval "die qq{ok\\n}; no indirect; use indirect::TestRequired1; my \$x = new Foo;";
+  eval "return; no indirect; use indirect::TestRequired1; my \$x = new Foo;";
  }
- is         $@, "ok\n",        'first require test doesn\'t croak prematurely';
- my $w = shift @w;
- like       $w, expect('Foo'), 'first require test catch errors in current scope';
- is_deeply \@w, [ ],           'first require test doesn\'t propagate into the required file';
+ is   $@,    '',            'first require test doesn\'t croak prematurely';
+ is   @w,    1,             'first require threw only one warning';
+ diag join "\n", 'All warnings:', @w if @w > 1;
+ like $w[0], expect('Foo'), 'first require test catch errors in current scope';
 }
 
 {
  my @w;
  {
   local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
-  eval "die qq{ok\\n}; no indirect; use indirect::TestRequired2; my \$x = new Bar;";
+  eval "return; no indirect; use indirect::TestRequired2; my \$x = new Bar;";
  }
+ is   $@, '', 'second require test doesn\'t croak prematurely';
  @w = grep !/^warn:Attempt\s+to\s+free\s+unreferenced/, @w if $] <= 5.008003;
- is   $@, "ok\n", 'second require test doesn\'t croak prematurely';
  my $w = shift @w;
  like $w, expect('Baz', 't/lib/indirect/TestRequired2.pm'),
                                      'second require test caught error for Baz';