Devel-DebugHooks
view release on metacpan or search on metacpan
t/41-chk_position.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More 'no_plan';
use Test::Output;
use FindBin qw/ $Bin /; my $lib = "-I$Bin/lib -I$Bin/../lib";
use Data::Section::Simple qw/ get_data_section /;
use Test::Differences;
unified_diff();
{
no warnings qw/ redefine prototype /;
*is = \&eq_or_diff;
}
sub n {
$_ = join '', @_;
s#\t# #gm;
s#(?:.*?)?([^/]+\.p(?:m|l))#xxx/$1#gm;
$_;
}
my $cmds;
my $script;
my $files = get_data_section();
($script = <<'PERL') =~ s#^\t##gm;
1;
2;
3;
PERL
$cmds = 'e [ DB::state("package") => DB::state("file") => DB::state("line") ];s;' x3;
is
n( `$^X $lib -d:DbInteract='$cmds' -e '$script'` )
,$files->{ 'position' }
,'Position should be updated for each step';
($script = <<'PERL') =~ s#^\t##gm;
sub t0 {
2;
}
sub t1 {
1;
}
sub t2 {
t1();
t0();
}
t2();
3;
PERL
$cmds = 'go,trace_returns,trace_subs';
is
n( `$^X $lib -d:DbInteract='$cmds' -e '$script'` )
,$files->{ 'position in subs' }
,'Position should be updated when call and return to/from subs';
( run in 0.486 second using v1.01-cache-2.11-cpan-0b5f733616e )