Skip to content

Instantly share code, notes, and snippets.

@shlomif
Created September 1, 2012 18:52
Show Gist options
  • Save shlomif/3583186 to your computer and use it in GitHub Desktop.
Save shlomif/3583186 to your computer and use it in GitHub Desktop.
Crude Prototype for Adding Test Coverage Traces for lib/perl5db.pl.
#!/usr/bin/perl
use strict;
use warnings;
use IO::All;
my $func_name = "DB::db_foo_trace";
my @lines = io("lib/perl5db.pl")->getlines();
my %where_traces_put;
my @indexes = (grep { $lines[$_] =~ /\A\s*push/ .. $lines[$_] =~ /;\s*\n?\z/ } keys(@lines));
my %ignore = (map { $_ => 1 } @indexes);
foreach my $i (keys(@lines))
{
if ($lines[$i] =~ m/;\s*\z/ and
($lines[$i] !~ /\Apackage / or $lines[$i] =~ /\A1;\s*\z/)
)
{
my $j = $i-1;
my $line_num = $i+1;
my $trace = "$func_name($line_num);";
my $ws_re = qr/\s*(?:#.*)?\n?/;
while (
exists($ignore{$j}) or
( not (
( $lines[$j] =~ s/(;)($ws_re)\z/$1$trace$2/)
or ( $lines[$j] =~ m/\{$ws_re\z/ and $lines[$j] !~ m/(?:=>)/
and $lines[$j] =~ s/(\{)($ws_re)\z/$1$trace$2/ )
or ( $lines[$j] =~ m/\}$ws_re\z/ and
$lines[$j] !~ m/(?:\{|=>|,)/ and
$lines[$j] =~ s/(\})($ws_re)\z/$1$trace$2/)
)
)
)
{
$j--;
}
$where_traces_put{$line_num} = 1;
}
}
io("perl5db_coverage_all_lines.txt")->print(
join '', map { "$_\n"} sort { $a <=> $b } keys(%where_traces_put)
);
my $big_string = join('', @lines);
my $code_to_add = "sub $func_name " . <<'EOF';
{
my ($line_num) = @_;
open my $append_fh, '>>', 'perl5db_coverage_trace.txt'
or die "Cannot open 'perl5db_coverage_trace.txt' - $!.";
print {$append_fh} "$line_num\n";
close($append_fh);
}
EOF
$code_to_add =~ s/\n//g;
# $big_string =~ s/\A/BEGIN{ $code_to_add ; };/ms;
$big_string =~ s/\A/$code_to_add ;/ms;
io("lib/perl5db.pl")->print($big_string);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment