DB.t revision 1
1N/A chdir 't' if -d 't'; 1N/A# symbolic references used later 1N/A# @DB::dbline values have both integer and string components (Benjamin Goldberg) 1N/A# must happen at compile time for DB:: package variable localizations to work 1N/A is( $ret, 3, 'DB::sub() should handle scalar context' ); 1N/A is( $ret, '1 4 9', '... should handle scalar context' ); 1N/A 'DB::DB() should return undef if $DB::ready is false'); 1N/A # change packages to mess with caller() 1N/A # assigning a number to $! seems to produce an error message, when read 1N/A local ($@, $,, $/, $\, $^W, $!) = (1 .. 5); 1N/A is( "$@$!$,$/$\$^W", "1\n0", 'DB::save() should reset punctuation vars' ); 1N/A # add clients and test to see if they are awakened 1N/A# test DB::_clientname() 1N/A 'DB::_clientname should return refname');
1N/A 'DB::_clientname should not return non refname');
1N/A# test DB::next() and DB::step() 1N/A # cannot test @stack 1N/A # cannot test @stack 1N/A# test DB::backtrace() 1N/A is( scalar @ret, 1, '... should report from provided stack frame number' ); 1N/A '... should find eval STRING construct'); 1N/A '... should respect context of calling construct'); 1N/A # does not check 'require' or @DB::args mangling 1N/A return (eval "one($_[0])")[-1]; 1N/A# test DB::trace_toggle 1N/A is( $subs, 0, 'DB::subs() should return keys of %DB::subs' ); 1N/A %DB::sub = ( foo => 'foo:23-45' , bar => 'ba:r:7-890' ); 1N/A my @expected = ( [ 'foo', 23, 45 ], [ 'ba:r', 7, 890 ] ); 1N/A# test DB::filesubs() 1N/A is( scalar @ret, 2, 'DB::filesubs() should use $DB::filename with no args'); 1N/A is( scalar @ret, 3, '... should pick up subs in proper file with argument'); 1N/A is( $dbf, $main, 'DB::files() should pick up filenames from %main::' ); 1N/A is( DB->lines->[0], 'foo', 'DB::lines() should return ref to @DB::dbline' ); 1N/A# test DB::loadfile() 1N/A 'DB::loadfile() should not find unloaded file' ); 1N/A '... should set *DB::dbline to associated glob'); 1N/A# test DB::lineevents() 1N/A local *baz = *{ "main::_<baz" }; 1N/A # array access in DB::lineevents() starts at element 1, not 0 1N/A is( join(' ', @{ $ret{1} }), 'two foo bar', '... should stash data in hash'); 1N/A# test DB::set_break() 1N/A 3 => "123\0\0\0abc", 1N/A 'main::foo' => 'foo:1-4', 1N/A is( $DB::dbline{1}, "foo\0", 'DB::set_break() should set break condition' ); 1N/A '... should use $DB::lineno without specified line' ); 1N/A is( $DB::dbline{4}, "1\0abc", '... should use default condition if needed'); 1N/A 'main::foo' => 'foo:1-4', 1N/A '... should use _find_subline() to resolve subname' ); 1N/A# test DB::set_tbreak() 1N/A is( $DB::dbline{1}, ';9', 'DB::set_tbreak() should set tbreak condition' ); 1N/A 'main::foo' => 'foo:1-4', 1N/A '... should use _find_subline() to resolve subname' ); 1N/A# test DB::_find_subline() 1N/A 'TEST::foo' => 'foo:10-15', 1N/A 'main::foo' => 'foo:11-12', 1N/A 'bar::bar' => 'foo:10-16', 1N/A 'DB::_find_subline() should find fully qualified sub' ); 1N/A '... should resolve unqualified package name to main::' ); 1N/A '... should resolve unqualified name with $DB::package, if defined' ); 1N/A '... should increment past lines with no events' ); 1N/A '... should not find nonexistant sub' ); 1N/A# test DB::clr_breaks() 1N/A 3 => "123\0\0\0abc", 1N/A is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action'); 1N/A is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' ); 1N/A local *{ "::_<foo" } = [ 0, 0, 0, 1 ]; 1N/A 'main::foo' => 'foo:1-3', 1N/A '... should find lines via _find_subline()' ); 1N/A '... should output warning if sub cannot be found'); 1N/A 'Relying on @DB::dbline in DB::clr_breaks() should clear breaks' ); 1N/A is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action'); 1N/A is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' ); 1N/A '... should only go to last index of @DB::dbline' ); 1N/A# test DB::set_action() 1N/A 'DB::set_action() should replace existing action' ); 1N/A '... should output warning if sub cannot be found'); 1N/A '... should warn if line cannot be actionivated' ); 1N/A# test DB::clr_actions() 1N/A is( $DB::dbline{3}, "123", '... should remove action, leaving break'); 1N/A local *{ "::_<foo" } = [ 0, 0, 0, 1 ]; 1N/A 'main::foo' => 'foo:1-3', 1N/A is( $DB::dbline{3}, "123", '... should find lines via _find_subline()' ); 1N/A '... should output warning if sub cannot be found'); 1N/A 'Relying on @DB::dbline in DB::clr_actions() should clear actions' ); 1N/A is( $DB::dbline{3}, "123", '... should remove action, leaving break'); 1N/A '... should only go to last index of @DB::dbline' ); 1N/A 'DB::prestop() should return undef for undef value' ); 1N/A# test DB::poststop(), not exactly parallel 1N/A 'DB::prestop() should return undef for undef value' ); 1N/A# test DB::evalcode() 1N/A 'DB::evalcode() should return undef for undef value' ); 1N/A# test DB::_outputall(), must create fake clients first 1N/A 'DB::_outputall() should call output(@_) on all clients' ); 1N/A# test virtual methods 1N/A# DB::skippkg() uses lexical 1N/A# DB::ready() uses lexical