#!perl
use
5.006;
my
$repl
= Runtime::Debugger->_init;
my
$INSTR
;
my
$COMPLETION_RETURN
;
MyTest->_setup_testmode_debugger(
$repl
);
sub
_setup_testmode_debugger {
my
(
$self
,
$_repl
) =
@_
;
$Runtime::Debugger::VERSION
=
"0.01"
;
my
$history_file
=
"$ENV{HOME}/.runtime_debugger_testmode.info"
;
open
my
$fh
,
">"
,
$history_file
or
die
$!;
close
$fh
;
$_repl
->{history_file} =
$history_file
;
$_repl
->_restore_history;
$_repl
->attr->{getc_function} =
sub
{
return
0
if
not
$INSTR
;
my
$char
;
(
$char
,
$INSTR
) =
$INSTR
=~ / ^ (.) (.*) $ /x;
ord
$char
;
};
$_repl
->attr->{attempted_completion_function} =
sub
{
my
(
$text
,
@possible
) =
$_repl
->_complete(
@_
);
$COMPLETION_RETURN
= [
@possible
];
(
$text
,
@possible
);
};
open
my
$NULL
,
">"
,
"/dev/null"
or
die
$!;
$_repl
->attr->{outstream} =
$NULL
;
$_repl
;
}
sub
_define_help_stdout {
[
''
,
' Runtime::Debugger 0.01'
,
''
,
' <TAB> - Show options.'
,
' <Up/Down> - Scroll history.'
,
' help - Show this section.'
,
' hist [N=5] - Show last N commands.'
,
' p DATA - Data printer (colored).'
,
' d DATA - Data dumper.'
,
' dd DATA, [N=3] - Dump internals (with depth).'
,
' q - Quit debugger.'
,
''
]
}
sub
init_case {
{
name
=>
'Help - upon running _step first time'
,
input
=>
''
,
nocolor
=> [
"stdout"
],
expected_results
=> {
line
=>
''
,
stdout
=> _define_help_stdout(),
},
};
}
sub
_run_case {
my
(
$_repl
,
$case
) =
@_
;
my
$stdin
=
$case
->{input} //
''
;
my
$step_return
;
my
$eval_return
;
my
$stdout
=
""
;
my
$EOL
=
"\cM"
;
$INSTR
=
$stdin
.
$EOL
;
$COMPLETION_RETURN
= [];
$_repl
->debug( 2 )
if
$case
->{debug};
eval
{
local
*STDOUT
;
local
*STDERR
;
open
STDOUT,
">"
, \
$stdout
or
die
$!;
open
STDERR,
">>"
, \
$stdout
or
die
$!;
$step_return
=
$repl
->_build_step;
$eval_return
=
eval
$step_return
//
""
;
chomp
$stdout
;
};
$_repl
->_show_error( $@ )
if
$@;
$_repl
->debug( 0 )
if
$case
->{debug};
my
$results_all
= {
stdin
=>
$stdin
,
comp
=>
$COMPLETION_RETURN
,
line
=>
$step_return
,
eval
=>
$eval_return
,
stdout
=> [
split
/\n/,
$stdout
, -1 ],
};
my
$nocolor
=
$case
->{nocolor};
if
(
$nocolor
and
@$nocolor
) {
for
my
$key
(
@$nocolor
) {
my
$val
=
$results_all
->{
$key
};
my
$ref
=
ref
$val
;
if
(
$ref
eq
"SCALAR"
) {
$results_all
->{
$key
} = colorstrip(
$val
);
}
elsif
(
$ref
eq
"ARRAY"
) {
$_
= colorstrip(
$_
)
for
@$val
;
}
else
{
warn
"Cannot apply 'nocolor' due to unsupport type '$ref'\n"
;
d
$results_all
;
}
}
}
my
%results
;
my
$expected_results
=
$case
->{expected_results};
my
@keys
=
keys
%$expected_results
;
@results
{
@keys
} =
@$results_all
{
@keys
};
my
$fail
;
TODO: {
local
$TODO
=
$case
->{name}
if
$case
->{todo};
$fail
= not is_deeply \
%results
,
$expected_results
,
$case
->{name};
}
my
$last
;
if
(
$case
->{debug} or (
$fail
and !
$case
->{todo} ) ) {
say
""
;
say
"GOT:"
;
say
explain
$results_all
;
say
""
;
say
"EXPECT:"
;
say
explain
$expected_results
;
$last
++;
}
$last
;
}
_run_case(
$repl
, init_case() );