Groups | Search | Server Info | Login | Register

Groups > perl.qa > #29

Devel::Cover better practice to identify uncovered files

Show all headers | View raw

Currently we are using this script to find files (line 48) under the scripts directory and add them to the coverage report. 

After running the programs under test, the script is run:

$ ./tests/script/cover-missing.pl
load
ingest
17 known covered file(s) found
preprocess
132 uncovered file(s) found and hashed
process
run: 1492558405.0000.10744
saving

Here it found over 100 files without executions, so our tests are not very comprehensive...

First question, is the code below the "best" way to do this?

Second question, is this something that could be provided by the Module via API or command line? Something like: cover -know fileName . Maybe even support if recursively find files if fileName is a directory.

$ cat -n tests/script/cover-missing.pl [source at https://sourceforge.net/u/jpyeron/logwatch/ci/master/tree/tests/script/cover-missing.pl]
     1  #!/usr/bin/perl -w
     2
     3  use Data::Dumper;
     4  use File::Find;
     5  use Cwd;
     6
     7  print "load\n";
     8
     9  use Devel::Cover::DB;
    10
    11  my $dbpath="cover_db";
    12  my $db = Devel::Cover::DB->new(db => $dbpath);
    13  my $timeStart=time;
    14  my $runKey="$timeStart.0000.$$";
    15  my %known;
    16
    17  print "ingest\n";
    18
    19  find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/runs/");
    20  find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/digests");
    21  find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/structure/");
    22
    23  sub process_coverfile
    24  {
    25      if (-f $_)
    26      {
    27          my $x=$db->read($_);
    28          foreach my $run ($x->runs)
    29          {
    30              my $h=$run->{digests};
    31              foreach my $file (keys %$h)
    32              {
    33                  if ( ! exists $known{$file} )
    34                  {
    35                      $known{$file}=$run->{digests}{$file};
    36                  }
    37              }
    38          }
    39      }
    40  }
    41
    42  print scalar keys %known, " known covered file(s) found\n";
    43
    44  print "preprocess\n";
    45
    46  my %toadd;
    47
    48  find({ wanted => \&process_file, no_chdir => 1 }, "scripts");
    49
    50  sub process_file
    51  {
    52      if (-f $_)
    53      {
    54          if ( ! exists $known{$_} )
    55          {
    56              $toadd{$_}=Devel::Cover::DB::Structure->digest($_);
    57          }
    58      }
    59  }
    60
    61  print scalar keys %toadd, " uncovered file(s) found and hashed\n";
    62
    63
    64  print "process\n";
    65
    66  if (scalar keys %toadd == 0)
    67  {
    68      print "no files to process\n";
    69      exit;
    70  }
    71
    72  print "run: $runKey\n";
    73
    74  $db->{runs}{$runKey}{"OS"}=$^O;
    75  $db->{runs}{$runKey}{"collected"}=["branch","condition","pod","statement","subroutine","time"];
    76  $db->{runs}{$runKey}{"dir"}=Cwd::abs_path();
    77  $db->{runs}{$runKey}{"vec"}={};
    78  $db->{runs}{$runKey}{"start"}=$timeStart;
    79  $db->{runs}{$runKey}{"run"}=$0;
    80  $_=$^V;
    81  s/v//;
    82  $db->{runs}{$runKey}{"perl"}=$_;
    83
    84  my $s=$db->{structure}=Devel::Cover::DB::Structure->new;
    85
    86  foreach my $file (keys %toadd)
    87  {
    88      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"branch"}=undef;
    89      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"condition"}=undef;
    90      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"pod"}=undef;
    91      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"subroutine"}=undef;
    92      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"time"}=undef;
    93      $db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"statement"}=0;
    94      $db->{structure}->{f}{$file}{file}=$file;
    95      $db->{structure}->{f}{$file}{digest}=$toadd{$file};
    96      $db->{structure}->{f}{$file}{statement}=[1];
    97      $db->{runs}{$runKey}{"count"}{$file}{'statement'}=[0];
    98      $db->{runs}{$runKey}{"digests"}{$file}=$toadd{$file};
    99  }
   100
   101  $db->{runs}{$runKey}{"finish"}=time;
   102
   103  print "saving\n";
   104
   105  $db->write("$dbpath/runs/$runKey");


-Jason

Back to perl.qa | Previous | Next — Next in thread | Find similar

Thread

Devel::Cover better practice to identify uncovered files jpyeron@pdinc.us ("Jason Pyeron") - 2017-04-18 19:43 -0400
  Re: Devel::Cover better practice to identify uncovered files jkeenan@pobox.com (James E Keenan) - 2017-04-18 22:27 -0400
    RE: Devel::Cover better practice to identify uncovered files jpyeron@pdinc.us ("Jason Pyeron") - 2017-04-18 22:47 -0400

csiph-web