Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Quick Perl coverage analyzer

by bikeNomad (Priest)
on May 25, 2001 at 23:04 UTC ( #83382=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info Ned Konz, ned@bike-nomad.com
Description: This uses the debugger to do a quick coverage analysis.

usage: run one script:

coverage script [ arg ... ] > listing.txt

or run multiple tests from a file of tests, one test per line.
coverage @file > listing.txt

output: subroutine summary and annotated listing on STDOUT, '-' signs show the lines that didn't get executed
#! /usr/bin/perl -w
# Perl coverage testing tool.
# Ned Konz 3/10/2000
# ned@bike-nomad.com
# $Revision: 1.1 $
# usage: run one script:
# coverage script [ arg ... ] > listing.txt
# or run multiple tests from a file of tests, one test per line.
# coverage @file > listing.txt
# output: annotated listing on STDOUT.

use strict;

my %coverage;
my %functions;
my $currentFile;
my $currentFunction;

my $tmpfile = `mktemp /tmp/coverageXXXXXX`;

$ENV{PERLDB_OPTS} = "NonStop AutoTrace LineInfo=$tmpfile";
$| = 1;

sub runOneTest
{
 my $test = shift;
 system("perl -d $test") == 0
  or die "can't open debugger: $!\n";

 open(DBOUT, $tmpfile)
  or die "can't open $tmpfile: $!\n";

 while (<DBOUT>)
 {
  if (/^(\D.*)\(([^(]+):(\d+)\):\s*(.*)$/)
  {
   $currentFunction = $1;
   $currentFile = $2;
   my $lineNumber = $3;
   my $otherStuff = $4;
   if (!exists($coverage{$currentFile}))
   {
    $coverage{$currentFile} = [];
   }
   if ($currentFunction !~ /CODE\(/)
   {
    $functions{$currentFunction} = $currentFile;
   }
   if ($otherStuff)
   {
    $coverage{$currentFile}->[$lineNumber] ++;
   }
  }
  elsif (/^(\d+):/)
  {
   $coverage{$currentFile}->[$1] ++;
  }
 }

 unlink $tmpfile;
}

sub printHeader
{
 my $header = shift;
 $header = "$header " if length($header) % 2;
 my $dashLength = (78 - length($header)) / 2;
 $dashLength = 2 if $dashLength < 2;
 print '=' x $dashLength . " $header " . '=' x $dashLength . "\n";
}

sub printSummary
{
 printHeader("FUNCTIONS");
 foreach my $function (sort(keys(%functions)))
 {
  printf "$function\t$functions{$function}\n";
 }

 printHeader("FILE COVERAGE");
 foreach my $file (sort(keys(%coverage)))
 {
  next if ! -r $file;
  next if ($file =~ qr{^/usr/.*/perl}); # skip system paths.
  printHeader($file);
  open(FILE, $file)
   or die "can't open $file: $!\n";
  for (my $lineNumber = 1; <FILE>; $lineNumber++)
  {
   my $prefix = ($coverage{$file}->[$lineNumber]) ? '  ' : '- ';
   $prefix = '  ' if (/^\s*#.*/);
   $prefix = '  ' if (/^sub\s+\w+\s*$/);
   $prefix = '  ' if (/^\s*[{};]*$/);
   $prefix = '  ' if (/^\s*package\s+[\w:]+\s*;\s*$/);
   print $prefix, $_;
  }
  close(FILE);
 }
}

# main program.

if ($ARGV[0] =~ /^@(.*)/)
{
 open(TESTS, $1);
 foreach my $test (<TESTS>)
 {
  chomp($test);
  print STDERR "Running $test\n";
  printHeader("Running $test");
  runOneTest($test);
 }
}
else
{
 runOneTest("@ARGV");
}

printSummary();

Replies are listed 'Best First'.
Re: Quick Perl coverage analyzer
by Coldstone (Acolyte) on Aug 04, 2006 at 16:22 UTC
    Seems cool, but I guess my perl inst is different somehow ...
    Compilation failed in require at /usr/lib/perl5/5.8.0/utf8.pm line 17. Compilation failed in require at regExTest3.pl line 3. main::BEGIN() called at /usr/lib/perl5/5.8.0/strict.pm line 3 eval {...} called at /usr/lib/perl5/5.8.0/strict.pm line 3 BEGIN failed--compilation aborted at regExTest3.pl line 3. can't open debugger: Bad file descriptor
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://83382]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2016-12-11 11:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:













    Results (169 votes). Check out past polls.