Created
May 15, 2010 04:59
-
-
Save exodist/402025 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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