stvn has asked for the wisdom of the Perl Monks concerning the following question:

I am seeing some weird behavior where Devel::Cover seems to be removing/consuming information I am trying to extract with caller(). I have managed to isolate the behavior in a small script, which is included below. Anyone else seen this problem before?

Here is the script: 

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 2;

{
    package TestCaller;

    use strict;
    use warnings;

    sub throw {
        my $self = bless {}, __PACKAGE__;
        my $i = 0;
        my @stack_trace;
        push @stack_trace, [ (caller($i))[0 .. 3] ] while caller(++$i)
+;        
        $self->{stack_trace} = \@stack_trace;
        die $self;
    }
}

eval { throw TestCaller };
isa_ok($@, 'TestCaller');

is_deeply($@->{stack_trace},
          [[ 'main', 'test.pl', 24, '(eval)']],
          '... got the stack trace we expected');
1;

[download]
And here is the output of that script 

[:~] stevan% perl test.pl
1..2
ok 1 - The object isa TestCaller
ok 2 - ... got the stack trace we expected
[:~] stevan% perl -MDevel::Cover test.pl
1..2
Devel::Cover 0.47: Collecting coverage data for branch, condition, pod
+, statement, subroutine and time.
Selecting packages matching:
Ignoring packages matching:
    /Devel/Cover[./]
Ignoring packages in:
    .
    /Library/Perl
    /Library/Perl/darwin
    /Users/stevan/Projects/PerlFramework
ok 1 - The object isa TestCaller
not ok 2 - ... got the stack trace we expected
#     Failed test (test.pl at line 27)
#     Structures begin differing at:
#          $got->[0][0] = Does not exist
#     $expected->[0][0] = 'main'
# Looks like you failed 1 tests of 2.
Devel::Cover: Writing coverage database to /Users/stevan/cover_db/runs
+/1094834470.5906.15059
---------------------------- ------ ------ ------ ------ ------ ------
+ ------
File                           stmt branch   cond    sub    pod   time
+  total
---------------------------- ------ ------ ------ ------ ------ ------
+ ------
test.pl                       100.0    n/a    n/a  100.0    n/a  100.0
+  100.0
Total                         100.0    n/a    n/a  100.0    n/a  100.0
+  100.0
---------------------------- ------ ------ ------ ------ ------ ------
+ ------

[download]
Am I doing something wrong? Or is this a limitation of Devel::Cover? Any thoughts? Does this have something to do with Devel::Cover's use of the runops function maybe?

I have asked this over at the perl-qa list as well, but I thought it would be useful to ask it here too.

-stvn

Replies are listed 'Best First'.
Re: Devel::Cover eating caller() information
by etcshadow (Priest) on Sep 10, 2004 at 20:38 UTC
    It isn't just that $@ is getting blown away, is it? Maybe change 
    eval { throw TestCaller };
isa_ok($@, 'TestCaller');

is_deeply($@->...

    [download]
    to 
    eval { throw TestCaller };
my $error = $@;
isa_ok($error, 'TestCaller');

is_deeply($error->...

    [download]
    And see if that makes any difference at all? Just a thought. Still, you ideally wouldn't want Devel::Cover to alter your program in any way. 
    ------------
:Wq
Not an editor command: Wq

    [download]
[reply]
[d/l]
[select]
      It isn't just that $@ is getting blown away, is it?

      No, I have tried that in the code that this issue originally showed up in. But now I have discovered something even weirder. When I changed this: 

      push @stack_trace, [ (caller($i))[0 .. 3] ] while caller(++$i);

      [download]
      to this (taken straight from Devel::StackTrace): 
      while ( do { package DB; @DB::args = (); @c = caller($i++) } ) {
    push @stack_trace, [ @c[0 .. 3] ];        
}

      [download]
      (Note the post-increment of $i instead of the pre-increment)

      This makes the Devel::Cover run work, and the plain test fail. So it seems that maybe Devel::Cover is pushing up the caller level?

      Oh well, still looking.

      -stvn
[reply]
[d/l]
[select]
Re: Devel::Cover eating caller() information
by stvn (Monsignor) on Sep 12, 2004 at 13:29 UTC

    It's kind of silly, but I am going to answer my own question here, in case anyone else runs into this problem, hopefully a super-search will get them to here.

    Well, I finally managed to find a solution, which was to replace this line: 

    push @stack_trace, [ (caller($i))[0 .. 3] ] while caller(++$i);  

    [download]
    with these lines: 
        {
        package DB;
        my $i = 0;            
        my @c;
        while (@c = caller($i++)) {
            next if $c[3] =~ /.*?\:\:throw/;
            push @stack_trace, [ @c[0 .. 7] ];        
        }
    }

    [download]
    For whatever reason, this needed to be called through the DB package to work under Devel::Cover, but the relationship between caller and DB are well known, so that was fine. The stack trace information gathering works the same, but since Devel::Cover seems to be messing with the index of the call stack the best way to was to capture more than I usually do, and to ignore the stack frames which came from my throw routine. This now passes both make test and Devel::Cover runs.

    I am still trying to figure out what the real reason behind this all is, and I am planning to examine it deeper so I can submit a bug report as well. Any thoughts, comments or suggestions are still welcome.

    -stvn
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom