File Coverage

bin/simple_report

Criterion	Covered	Total	%
statement	71	81	87.6
branch	31	44	70.4
condition	9	14	64.2
subroutine	6	6	100.0
pod			n/a
total	117	145	80.6

#!/usr/bin/env perl
use strict;
use warnings;

use Getopt::Long;
use TAP::Parser;

our $VERSION = "2.00";
$|++;

#  simple_report NAME

my($verbose, $status);
GetOptions("verbose+" => \$verbose,
           "status"   => \$status);

my $test_name = shift || "UNNAMED_TEST";
my $parser = TAP::Parser->new( { source => \*STDIN } );

my %totals  = (
                max       => undef,
                seen      => 0,

                ok        => 0,
                todo      => 0,
                skip      => 0,
                bonus     => 0,
                unplanned => 0,

                details   => {}
               );

my $current_test_count = 0;
my $unplanned = 0;
my $sharp = "# ";
my $last_item;

# Read and analyze input.
TAP_LINE:
  while( defined(my $item = $parser->next) ) {

      # If this is a "Bail out!" just quit.
      last if $item->is_bailout;

      # Comments are assumed to "belong" to the last test seen.
      if ($item->is_comment) {
          next TAP_LINE if $item->as_string =~ /\A# Looks like /;
          push @{ $totals{details}->{$current_test_count}->{lines} }, $item->as_string;
          next TAP_LINE;
      }

      # Record the predicted max test number if this is a plan line.
      # If this is a skip_all, then quit.
      if ($item->is_plan and not defined $totals{plan}) {
          last TAP_LINE if $item->has_skip;
          # First test plan seen.
          $totals{max} = $item->tests_planned;
          next TAP_LINE;
      }

      # Should be a test; bump the test count by 1 if so.
      if ($item->is_test) {
          $current_test_count++, $totals{seen}++;
          $totals{details}->{$current_test_count}->{item} = $item;
      }

      if ($item->is_actual_ok) {
          $totals{ok}++;
      }
      if ($item->has_todo) {
          $totals{todo}++;
          $totals{ok}++, $totals{bonus}++ if $item->todo_passed;
      }
      $totals{skip}++  if $item->has_skip;

      if ($status and not defined $totals{max} ) {
          $unplanned++;
          print "$sharp.";
          $sharp = '';
      }
      elsif ($status) {
          printf STDERR "$sharp %2.1d%% complete\n", ($totals{seen}*1.0/$totals{max})*100;
      }
  }
print "\n" if $unplanned;


# Print summary
print "$test_name: tests=$totals{seen}, ",
                  "ok=$totals{ok}, ",
                  "failed=@{[$totals{seen}-$totals{ok}]}, ",
                  "skipped=$totals{skip}, ",
                  "todo=$totals{todo}";
print $totals{bonus}
        ? " ($totals{bonus} UNEXPECTEDLY SUCCEEDED)"
        : "";
print $totals{unplanned}
        ? " ($totals{unplanned} UNPLANNED)"
        : "";
print "\n";

if ($status) {
   print STDERR "$sharp $test_name: tests=$totals{seen}, ok=$totals{ok}, failed=@{[$totals{seen}-$totals{ok}]}, skipped=$totals{skip}, todo=$totals{todo}";
   print STDERR $totals{bonus} ? " ($totals{bonus} UNEXPECTEDLY SUCCEEDED)" : "";
   print STDERR $totals{unplanned} ? " ($totals{unplanned} UNPLANNED)" : "";
   print STDERR "\n";

}

# Print details if requested
if ($verbose) {
  for my $test_number (sort keys %{ $totals{details} }) {
        my $item = $totals{details}->{$test_number}->{item};
        my $lines = $totals{details}->{$test_number}->{lines};
        (my $description = $item->description) =~ s/\A-\s+//;

        if ($item->has_todo and $item->todo_passed) {
            printf "T %d %s\n",$test_number, $description;
            verbose_details($lines);
        }
        elsif (not $item->is_ok and not $item->has_todo) {
            printf "F %d %s\n", $test_number, $description;
            verbose_details($lines);
        }
    }
}

sub verbose_details {
    my $lines = shift;
    # Print detailed details (diags) if requested
    if ($verbose > 1) {
        # Super-verbose - all diags will be there, including snapshot
        print  map {"$_\n"} @$lines;
    }
    else {
        # Plain verbose - snapshots only (if any)
        snapshot($lines);
    }
}

sub snapshot {
  my($lines) = shift;
  print map { "$_\n" } grep { /^(See snapshot.*\z)/sm } @{ $lines };

}

__END__