Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
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();

Comment on Quick Perl coverage analyzer
Download Code
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

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://83382]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (13)
As of 2014-08-27 12:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (238 votes), past polls