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

+ -

  Perl debugger: stop at a specific test number on 2008.02.28 14:48 AndyArmstrong

Submitted by AndyArmstrong on 2008.02.28 14:48
Tools
AndyArmstrong writes "I like data driven tests. The general pattern is a big array of test cases and some driver code at the bottom that loops over the cases applying the same assertions to each of them.

That's all well and good until you want to use the Perl debugger to step through test #1967 of 2673. There's no good place to set a break point because the driver loop will execute many times before it hits the test you want to single step through. You can fake it like this:

if (Test::Builder->new->current_test >= 85) {
    $DB::single = 1;
}

Setting $DB::single to a true value makes the debugger break at the following line. It'd be much nicer though to be able to set a magic breakpoint in the debugger that'd stop at test #1967. Add the following code to your ~/.perldb and that's exactly what you'll be able to do.

my @opts = qw( windowSize=30 );

if ( $] >= 5.010000 ) {
    push @opts, "HistFile='" . glob( '~/.perldb_history' ) . "'";
}

parse_options( $_ ) for @opts;

@DB::testbreak = ();

# Monkeypatch cmd_b (set breakpoint)
my $cmd_b = \&DB::cmd_b;
*DB::cmd_b = sub {
    my ( $cmd, $line, $dbline ) = @_;
    if ( $line =~ /\s*#\s*(\d+(?:\s*,\s*\d+)*)$/ ) {
        my %seen;
        @DB::testbreak = grep { !$seen{$_}++ }
          sort { $a <=> $b } ( split( /\s*,\s*/, $1 ), @DB::testbreak );
    }
    else {
        $cmd_b->( @_ );
    }
};

sub afterinit {
    $trace |= 4;    # Enable watchfunction
}

sub watchfunction {
    if ( @DB::testbreak && exists $INC{'Test/Builder.pm'} ) {
        my $next = Test::Builder->new->current_test + 1;
        if ( $next >= $DB::testbreak[0] ) {
            shift @DB::testbreak
              while @DB::testbreak && $next >= $DB::testbreak[0];

            my $depth = 1;
            while ( 1 ) {
                my ( $package, $file, $line ) = caller $depth;
                last unless defined $package;
                last unless $package =~ /^Test::/;
                $depth++;
            }
            $DB::stack[ -$depth ] = 1;
        }
    }

    return;
}

It modifies the debugger's 'b' (breakpoint) command so that you can type:

  DB<1> b #1967
  DB<1> c

That'll run the tests until immediately after test #1966 and then stop, ready for the setup to the test you're interested in. Regular breakpoints still work as normal.

It's a little rough and ready. It decides which scope to stop in by unwinding the call stack skipping past any packages that are called Test::* - if your package naming doesn't work like that you'll have to hack it about a bit.

If you have any improvements please let me know.

"
Read More 0 comments

This discussion was created as logged-in users only. Log in and try again!
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
Loading... please wait.