Ensure test accuracy by requiring diags to match

rafl · Aug 13, 2013 · 36c2c4c · 36c2c4c
1 parent 34deb0d
commit 36c2c4c
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 45 deletions.
diff --git a/t/lib/AggTestTester.pm b/t/lib/AggTestTester.pm
@@ -36,6 +36,7 @@ sub new {
     mod   => $mod,
     tests => $tests,
     exp   => $exp,
+    diag  => delete($extra{diag}) || [],
     args  => { %extra },
   }, $class;
 }
@@ -118,14 +119,26 @@ sub run {
 
   # Check diag to see that we ran each script.
   # This is redundant with the setup block test but it makes me feel good.
-  my @exp_diag = @{ $self->{tests} };
-  my $total = @exp_diag;
-  foreach my $diag ( @{ $tb->{diag} } ){
-    $diag =~ / $exp_diag[0] \(\d out of $total\)/
-      and shift(@exp_diag);
-    last if !@exp_diag;
+  my @exp_diags = (
+    (map { qr/ $_ \(\d out of ${\scalar @{ $self->{tests} }}\)/ }
+      @{ $self->{tests} }),
+    @{ $self->{diag} },
+  );
+  my @diags = @{ $tb->{diag} };
+  my @unmatched;
+
+  is scalar(@exp_diags), scalar(@diags), 'expected number of diagnostics';
+
+  DIAG: while( my $diag = shift @diags ){
+    foreach my $exp_msg ( @exp_diags ){
+      $diag =~ $exp_msg
+        and next DIAG;
+    }
+    push @unmatched, $diag;
   }
-  is scalar(@exp_diag), 0, "$mod - All aggregated test scripts found in diag";
+
+  is scalar(@unmatched), 0, 'all diagnostics matched'
+    or diag explain \@unmatched;
 }
 
 1;
diff --git a/t/nested_skip_to_end.t b/t/nested_skip_to_end.t
@@ -11,44 +11,19 @@ use Test::More;
 
 only_with_nested {
 
-  my $diag = \&Test::More::diag;
-  my @diags;
-  no warnings 'redefine';
-  local *Test::More::diag = sub {
-    # If it's one of the ones we want, capture it (and hide it).
-    if( $_[0] =~ /WARNING:.+unknown if .+? actually finished/sm ){
-      push @diags, $_[0];
-    }
-    # Else just do the normal.
-    else {
-      $diag->(@_);
-    }
-  };
-
-  subtest Nested => sub {
-
-    Test::Aggregate::Nested->new({
-      verbose         => 2,
-      tests           => [
-        catfile('aggtests', 'skip_to_end.t'),
+  aggregate(
+      'Test::Aggregate::Nested',
+      [
         catfile('aggtests-extras', 'skip_to_end_undefined.t'),
+        catfile('aggtests', 'skip_to_end.t'),
       ],
-    })->run;
-
-  };
-
-  is @diags, 1, 'only captured one diag';
-
-  foreach my $msg ( @diags ){
-    like $msg,
-      qr/ unknown if .+?\bskip_to_end_undefined\.t\b.+? actually finished/,
-      'undefined value after skip produces warning';
-
-    like $msg,
-      qr/ error was set \(\$!\):/,
-      'error message included in warning';
-  }
-
+      [
+        [ 1, qr/Tests for .+?\bskip_to_end_undefined\.t/, 'skipped to end' ],
+        [ 1, qr/Tests for .+?\bskip_to_end\.t/, 'skipped to end' ],
+      ],
+      diag => [
+      ],
+  );
 };
 
 done_testing;
diff --git a/t/read_failure.t b/t/read_failure.t
@@ -22,12 +22,17 @@ my $path = catfile(qw(aggtests-does-not-exist no-really-it-should-not-exist.t));
 only_with_nested {
   my $gen_exp_results = sub {
     my $path = shift;
-    return [
+    return ([
       [
         0, qr/No tests run for subtest .+?\Q$path\E/,
         "Read failure results in failed test",
       ]
-    ];
+    ],
+      diag => [
+        qr/unknown if .+?\Q$path\E.+? actually finished/,
+        qr/No tests run/,
+      ],
+    );
   };
 
   # A file that doesn't exist.