Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Journal of jjore (6662)

Sunday May 09, 2010
12:43 PM

Stop the debugger when a test fails

[ #40350 ]

I was debugging some test failures earlier this morning but they were in the middle of a long test script. I thought it'd be nice if I could step through the test with the debugger and just stop whenever a test failed.

Here's the result. A test failure immediately followed by being in the debugger:

not ok 236
14:                    return $result;
  DB<1>

and then I could ask for the stack trace which is nice:

  DB<1> T
. = main::ok(undef) called from file `t/02_methods.t' line 796
. = main::check_tar_extract(ref(Archive::Tar), ref(ARRAY)) called from file `t/02_methods.t' line 507

I wrote the below snippet to automatically stop the debugger whenever something like ok() failed. Currently you can just drop this right after your "use Test::More" statement. I think possibly this kind of idea should be packaged in a no-muss CPAN module or perhaps directly right into Test::More.

# Wrap Test::More functions with debugger breakpoints
BEGIN {
    use B;
 
    # Enumerate over all symbols in the main:: symbol table.
    SYMBOL:
    for my $symbol ( sort keys %main:: ) {
 
        # Choose only things that are functions.
        {
            no strict 'refs';
            next SYMBOL if ! defined &$symbol;
        }
 
        # Get a reference to the function.
        my $code = do {
            no strict 'refs';
            \&$symbol;
        };
 
        # Get a B::CV object so I can get at meta-data about the
        # function.
        my $cv   = B::svref_2object( $code );
 
        # Get the path to the compilation file. Will often be a path like
        # '/usr/share/perl/5.10/Test/More.pm'.
        #
        # To visually inspect other meta-data possibly available about this function:
        #
        #     use Devel::Peek;
        #     Dump( $code );
        #
        my $src_file = $cv->FILE;
 
        # Select only functions coming from files named like
        # .../Test/More.pm.
        next SYMBOL if $src_file !~ m{/Test/More\.pm$};
 
        # Propagate the old function's prototype to the new function.
        my $prototype = prototype $code;
        my $new_prototype =
            defined $prototype
            ? "($prototype)"
            : '';
 
        # Generate the new function and replace the old function. The new function
        # has access to the original via the closed-over $old variable.
        my $src = qq{
            no warnings 'redefine';
            sub $symbol $new_prototype {
 
                # Call the original function and get the test pass/fail.
                my \$result = \$code->( \@_ );
 
                # Debugger single-stepping mode if the test failed.
                if ( ! \$result ) {
                    \$DB::single = 1;
                }
 
                # Return the test/failure.
                return \$result;
            }
 
            # Compilation of the new function succeeded?
            1;
        };
        eval $src
            or die $@;
    }
}

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • I've wished I had that sort of module in the past, often when debugging testing modules. Unfortunately, I'm not to the point of being able to pull out the magic B wand and make it do what I want to do yet.

    When you DO make it into a module, make the regexp {/Test/(*.)\.pm\z}, OK? That way it covers any testing module, not just Test::More.

    --
    The new Strawberry Perl for Windows has been released! Check http://strawberryperl.com for it.
  • Thanks, this is a nicely commented way of doing mass-wrapping of stuff. I'll have to keep it in mind for other Evil Things to do...