Skip to content

Instantly share code, notes, and snippets.

@exodist
Created May 15, 2010 04:59
Show Gist options
  • Save exodist/402025 to your computer and use it in GitHub Desktop.
Save exodist/402025 to your computer and use it in GitHub Desktop.
The following will try to find the line number using the following logic:
Asserts calls are not method calls
Asserts are the last call from the class using the known assert (ok)
A stack of line numbers starting from the last known assert class can be listed in cases of ambiguity, This narrows the list down to a couple choices for the user. For instance, "Test failure at line number 10, 20, or 30.
This gives the user useful information, does not require anyone to do anything special when writing assertions that call is, ok, etc. In some cases it might not be the exact line number, but will probably never give more than 2 or 3 choices.
#!/usr/bin/perl
package Test::LineNumber;
use strict;
use warnings;
{
package Test::MyStuff;
use Test::More;
use Scalar::Util qw/blessed/;
sub the_new_ok { highest( @_ )}
sub stack {
my $i = 1;
package DB;
my @out;
while ( my @info = caller( $i )) {
push @out => [ @info[0,2,3,], [@DB::args]];
$i++;
}
return @out;
}
sub highest {
ok( @_ );
my @lines;
my $possible;
my @depth;
my @stack = stack();
until( @lines ) {
no warnings 'uninitialized';
my @data = @{ shift( @stack ) || []};
my $is_method_call = @data && $data[3] && $data[3][0]
&& (blessed($data[3][0]) || $data[3][0]) eq $data[0];
if ( !@data || $data[2] =~ m/__ANON__$/ || $is_method_call ) {
push @lines => @depth if @depth;
push @lines => $possible if $possible;
@lines = ( undef ) unless @lines;
last;
}
my $package = __PACKAGE__;
next if $data[0] eq $package;
# First call from test package
$possible ||= $data[1];
# Last call to named function in test package
push @depth => $data[1]
unless $data[2] =~ m/^$package\::/;
}
return $lines[0] unless wantarray;
return @lines;
}
}
*ok = \&Test::MyStuff::the_new_ok;
*is = \&Test::MyStuff::is;
*is_deeply = \&Test::MyStuff::is_deeply;
sub ln {
my ($offset) = @_;
( undef, undef, my $line ) = caller;
return $line + $offset;
}
sub tests {
my $ln = my_ok( 1, "Custom tester" );
is( $ln || undef, ln(-1) || undef, "Corrent line number method call" );
}
sub my_ok {
return ok( @_ );
} is( ok(1), ln(0), "line number of imported function" );
is( scalar my_ok( 'apple' ), ln(0), "Line number from package level" );
__PACKAGE__->tests;
bless( [], __PACKAGE__)->tests;
is_deeply(
[my_ok( 1, "deep" )],
[90, 82],
"Can report several line numbers if ambiguous"
);
Test::MyStuff::done_testing;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment