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 ]

AndyArmstrong (7200)

AndyArmstrong
  (email not shown publicly)
http://hexten.net/
Thursday February 28, 2008
02:48 PM

Perl debugger: stop at a specific test number

[ #35792 ]

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.

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.
  • Doesn't just plain "b Test::Builder->new->current_test >= 85" work?
    • You can type that if you want, but I'd much rather type 'b #87'.

      Yeah, it's not as generic as what you've written, but at the end of the day, I want a lot more people playing with the debugger so they can, er, debugger it.

      • Also, no - it doesn't work. You need a line number or subroutine name before the condidtion.

        You can use:

          w Test::Builder->new->current_test >= 87

        which is nearly the right thing - but that halts inside Test::Builder - so then you have to hit r a few times to get back to the debuggee.

        So it's sugar, it gets you to the right place simply, and in my case - because I have the debugger set up to take my editor to whatever file / line it stops on - it stops a lot of spurious windows containi