local
$::RD_TRACE = 1;
local
$Data::Dumper::Sortkeys
= 1;
if
(!
$ENV
{
"CI"
}) {
plan
skip_all
=>
"Only checked in continuous integration."
;
done_testing();
exit
;
}
my
%grammar_dependencies
= obtain_dependencies();
my
$opts
= LaTeXML::Common::Config->new(
input_limit
=> 100,
verbosity
=>-2);
my
$converter
= LaTeXML->get_converter(
$opts
);
$converter
->prepare_session(
$opts
);
my
%tested_dependencies
= ();
my
@core_tests
= parser_test_filenames();
for
my
$test
(
@core_tests
) {
note(
"grammar coverage $test..."
);
my
$regularized_log
=
''
;
my
$response
;
my
$log_handle
;
open
(
$log_handle
,
">>"
, \
$regularized_log
) or croak(
"Can't redirect STDERR to log! Dying..."
);
{
local
*STDERR
=
*$log_handle
;
binmode
(STDERR,
':encoding(UTF-8)'
);
$response
=
$converter
->convert(
$test
);
}
$regularized_log
=~ s/\:\s+\|\n\s*\|\s+\|\[/\: \[/g;
note(
$response
->{status});
my
@log_lines
=
split
(
"\n"
,
$regularized_log
);
my
$prev_line
=
''
;
for
my
$line
(
@log_lines
) {
if
(
$line
=~ /(\w+)\s*\|(?:(?:\>\>(?:\.*)Matched(?:\(keep\))? (?:subrule|production))|(?:\(consumed))\:\s*\[\s*(\w+|\
$arg
\[\d+\])/) {
my
$parent
= $1;
my
$child
= $2;
if
(
$child
=~ /^\
$arg
/) {
if
(
$prev_line
=~ /^\s*\d+\|\s*(\w+)\s*\|/) {
$child
= $1;
}
}
if
(
$parent
ne
$child
) {
$tested_dependencies
{
$parent
}{
$child
} = 1;
}
}
$prev_line
=
$line
;
}
}
my
$ok_count
= 0;
my
$missing_count
= 0;
my
$extra_count
= 0;
my
%missing
= ();
my
%extra
= ();
delete
$grammar_dependencies
{
'Start'
};
delete
$grammar_dependencies
{
'AnythingAn'
}{
"FLOATSUPERSCRIPT"
};
delete
$grammar_dependencies
{
'AnythingAn'
}{
"MODIFIER"
};
delete
$grammar_dependencies
{
'AnyOp'
}{
"OPERATOR"
};
delete
$grammar_dependencies
{
'AnyOp'
}{
"addScripts"
};
delete
$grammar_dependencies
{
'AnyOp'
}{
"preScripted"
};
delete
$grammar_dependencies
{
'argPunct'
}{
'VERTBAR'
};
delete
$grammar_dependencies
{
'Expression'
}{
'punctExpr'
};
delete
$grammar_dependencies
{
'aSuperscri'
}{
'AnyOp'
};
delete
$grammar_dependencies
{
'aSuperscri'
}{
'Expression'
};
delete
$grammar_dependencies
{
'Superscrip'
}{
'endPunct'
};
delete
$grammar_dependencies
{
'Subscript'
}{
'endPunct'
};
delete
$grammar_dependencies
{
'doubtArgs'
}{
'forbidArgs'
};
delete
$grammar_dependencies
{
'requireArg'
};
for
my
$rule
(
grep
{!/^_/}
keys
%tested_dependencies
) {
my
$subrules
=
$tested_dependencies
{
$rule
};
for
my
$subrule
(
keys
%$subrules
) {
if
(
$rule
ne
$subrule
) {
if
(
$grammar_dependencies
{
$rule
}{
$subrule
}) {
delete
$grammar_dependencies
{
$rule
}{
$subrule
};
$ok_count
+= 1;
}
else
{
$extra_count
+= 1;
$extra
{
$rule
}{
$subrule
} = 1;
}
}
}
}
for
my
$rule
(
keys
%grammar_dependencies
) {
my
$subrules
=
$grammar_dependencies
{
$rule
} || ();
for
my
$subrule
(
keys
%$subrules
) {
if
(
$rule
ne
$subrule
) {
$missing_count
+= 1;
$missing
{
$rule
}{
$subrule
} = 1;
}
}
}
ok(
$ok_count
> 100,
"Tested a big subset of MathGrammar"
);
is(
$missing_count
, 0,
"MathGrammar dependencies (currently tested in $ok_count cases), were not matched in the following cases: \n"
.Dumper(\
%missing
));
done_testing();
sub
parser_test_filenames {
my
$directory
=
"t/parse"
;
my
$dir
;
if
(!
opendir
(
$dir
,
$directory
)) {
return
do_fail(
$directory
,
"Couldn't read directory $directory:$!"
); }
else
{
my
@dir_contents
=
sort
readdir
(
$dir
);
my
$t
;
my
@core_tests
=
map
{ ((
$t
=
$_
) =~ /\.tex$/ ? (
"t/parse/$t"
) : ()); }
@dir_contents
;
closedir
(
$dir
);
@core_tests
;
}
}
sub
obtain_dependencies {
my
$internalparser
= LaTeXML::MathGrammar->new();
my
%dependencies
= ();
my
@rule_names
=
grep
{!/^_/}
keys
%{
$$internalparser
{rules}};
for
my
$rule
(
@rule_names
) {
my
$calls
=
$$internalparser
{rules}{
$rule
}{
"calls"
} || [];
for
my
$call
(
@$calls
) {
if
(
$call
!~ /^_/) {
$dependencies
{c14n(
$rule
)}{
$call
} = 1;
}
}
my
$prods
=
$$internalparser
{rules}{
$rule
}{
"prods"
} || [];
for
my
$prod
(
@$prods
) {
my
$items
=
$$prod
{items} || [];
for
my
$item
(
@$items
) {
if
(
$$item
{argcode} &&
$$item
{subrule}) {
if
(
$$item
{argcode} =~/^\[
'(.+)'
\]$/) {
$dependencies
{c14n(
$$item
{subrule})}{$1} = 1;
}
}
}
}
}
%dependencies
}
sub
c14n {
my
$rule
=
shift
;
return
substr
(
$rule
, 0,10);
}
1;