develooper Front page | perl.qa | Postings from April 2017

Devel::Cover better practice to identify uncovered files

Thread Next
From:
Jason Pyeron
Date:
April 18, 2017 23:43
Subject:
Devel::Cover better practice to identify uncovered files
Message ID:
70A9F07F6DBA46B7A1F97A7E59DBEAA4@black7
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

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About