my
$config_file
=
'xt/author/lib.ini'
;
my
$config
= Config::Tiny ->
read
(
'xt/author/lib.ini'
)
or
die
Config::Tiny -> errstr();
our
$LIB
=
$config
->{_}->{lib};
die
"No library defined in file '$config_file'"
unless
defined
$LIB
;
die
"Invalid library name '$LIB' in file '$config_file'"
unless
$LIB
=~ /^[A-Za-z]\w*(::\w+)*\z/;
eval
"require $LIB"
;
die
$@
if
$@;
can_ok(
$LIB
,
'_check'
);
my
@data
;
push
@data
, ([
"$LIB->_zero()"
, 1 ],
[
"$LIB->_one()"
, 1 ],
[
"$LIB->_two()"
, 1 ],
[
"$LIB->_ten()"
, 1 ]);
for
(
my
$n
= 0 ;
$n
<= 24 ; ++
$n
) {
push
@data
, [
qq|$LIB->_new("1|
. ("0
" x $n) . qq|"
)|, 1 ];
}
push
@data
, ([
"undef"
, 0 ],
[
"''"
, 0 ],
[
"1"
, 0 ],
[
"[]"
, 0 ],
[
"{}"
, 0 ]);
for
(
my
$i
= 0 ;
$i
<=
$#data
; ++
$i
) {
my
(
$in0
,
$out0
) = @{
$data
[
$i
] };
my
(
$x
,
@got
);
my
$test
=
qq|\$x = $in0; |
.
qq|\@got = $LIB->_check(\$x);|
;
diag(
"\n$test\n\n"
)
if
$ENV
{AUTHOR_DEBUGGING};
eval
$test
;
is($@,
""
,
"'$test' gives emtpy \$\@"
);
subtest
"_check() in list context: $test"
,
sub
{
plan
tests
=> 3,
cmp_ok(
scalar
@got
,
"=="
, 1,
"'$test' gives one output arg"
);
is(
ref
(
$got
[0]),
""
,
"'$test' output arg is a scalar"
);
if
(
$out0
) {
ok(!
$got
[0],
"'$test' output arg is false (object OK)"
)
or diag(
" got: $got[0]\n expected: (something false)"
);
}
else
{
ok(
$got
[0],
"'$test' output arg is true (object not OK)"
)
or diag(
" got: $got[0]\n expected: (something true)"
);
}
};
}
for
(
my
$i
= 0 ;
$i
<=
$#data
; ++
$i
) {
my
(
$in0
,
$out0
) = @{
$data
[
$i
] };
my
(
$x
,
$got
);
my
$test
=
qq|\$x = $in0; |
.
qq|\$got = $LIB->_check(\$x);|
;
diag(
"\n$test\n\n"
)
if
$ENV
{AUTHOR_DEBUGGING};
eval
$test
;
is($@,
""
,
"'$test' gives emtpy \$\@"
);
subtest
"_check() in scalar context: $test"
,
sub
{
plan
tests
=> 2,
is(
ref
(
$got
),
""
,
"'$test' output arg is a scalar"
);
if
(
$out0
) {
ok(!
$got
,
"'$test' output arg is false (object OK)"
)
or diag(
" got: $got\n expected: (something false)"
);
}
else
{
ok(
$got
,
"'$test' output arg is true (object not OK)"
)
or diag(
" got: $got\n expected: (something true)"
);
}
};
}