Devel-DebugHooks

 view release on metacpan or  search on metacpan

t/40-chk_frames.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;
	sub t1 {
		1;
		2;
	}
	sub t2 {
		t1();
		3;
	}
	t2();
	4;
PERL

$cmds =  'e DB::state( "stack" );s;'x3 .'s;e DB::state( "stack" );'x2;
is
	n( `$^X $lib -d:DbInteract='$cmds' -e '$script'` )
	,$files->{ 'subroutine frames' }
	,"Check subroutine frames";

$cmds =  'e DB::state( "goto_frames" );s;'x3 .'s;e DB::state( "goto_frames" );'x2;
is
	n( `$^X $lib -d:DbInteract='$cmds' -e '$script'` )
	,$files->{ 'goto frames' }
	,"Check goto frames";



($script =  <<'PERL') =~ s#^\t##gm;
	sub t1 {
		1;
	}
	sub t2 {
		goto &t1;
	}
	t2();
	4;



( run in 0.812 second using v1.01-cache-2.11-cpan-6aa56a78535 )