/) {
# we are now in the code block
$state = 2;
next;
} elsif (m/==== +(.*) +====/) {
# we are in some other block
$theName = lc($1);
$theAttributes->{$theName} = "";
next;
}
if (m/^Reference: +(.*)$/) {
$theAttributes->{reference} = $theSpecURL . "#" . $1;
} elsif ($theName ne "") {
# accumulate whatever was in the block under the data for it
chomp();
$theAttributes->{$theName} .= $_;
} elsif (m/TODO/) {
$state = 0;
}
}
if ($state == 2) {
if (m/<\/pre>/) {
# we are done with the code block
$state = 3;
} else {
if (m/^\s/ && !m/if given/) {
# trim any trailing whitespace
$theCode =~ s/ +$//;
$theCode =~ s/\t/ /g;
$theCode .= $_;
# In MediaWiki, to display & symbol escapes as literal text, one
# must use "&&" for the "&" character. We need to undo that.
$theCode =~ s/&(\S)/&$1/g;
}
}
} elsif ($state == 3) {
# look for a table
if (m/^\{\|/) {
# table started
$state = 4;
}
} elsif ($state == 4) {
if (m/^\|-/) {
if ($theAPI
&& exists($theAsserts->{$theAPI}->[$theAssertCount])
&& scalar(@{$theAsserts->{$theAPI}->[$theAssertCount]})) {
$theAssertCount++;
}
# start of a table row
if ($theType ne "" && $typeRows) {
# print qq($theType typeRows was $typeRows\n);
# we are still processing items for a type
$typeRows--;
# populate the first cell
$theAsserts->{$theAPI}->[$theAssertCount] = [ $theType ] ;
} else {
$theType = "";
}
} elsif (m/^\|\}/) {
# ran out of table
$state = 5;
# adding processing for additional block types
# a colspan followed by a keyword triggers a start
# so |colspan=5|element triggers a new collection
# |colspan=5|attribute triggers the setting of an attribute
} elsif (m/^\|colspan="*([0-9])"*\|([^ ]+) (.*)$/) {
my $type = $2;
my $params = $3;
my $obj = {} ;
if ($type eq "attribute") {
if ($params =~ m/([^:]+):([^ ]+) +(.*)$/) {
$obj = {
type => $type,
element => $1,
attribute => $2,
value => $3
};
$theStep = undef;
push(@steps, $obj);
} else {
print STDERR "Malformed attribute instruction at line $lineCounter: " . $_ . "\n";
}
} elsif ($type eq "event") {
if ($params =~ m/([^:]+):([^ ]+).*$/) {
$obj = {
type => $type,
element => $1,
value => $2
};
$theStep = undef;
push(@steps, $obj);
} else {
print STDERR "Malformed event instruction at line $lineCounter: " . $_ . "\n";
}
} elsif ($type eq "element") {
$obj = {
type => "test",
element => $3
};
push(@steps, $obj);
$theStep = scalar(@steps) - 1;
$theAsserts = $steps[$theStep];
} else {
print STDERR "Unknown operation type: $type at line " . $lineCounter . "; skipping.\n";
}
} elsif (m/($apiNamesRegex)$/) {
my $theString = $1;
$theString =~ s/ +$//;
$theString =~ s/^ +//;
if ($theString eq "IA2") {
$theString = "IAccessible2" ;
}
my $rows = 1;
if (m/^\|rowspan="*([0-9])"*\|(.*)$/) {
$rows = $1
}
if (grep { $_ eq $theString } @apiNames) {
# we found an API name - were we already processing assertions?
if (!$theAsserts) {
# nope - now what?
$theAsserts = {
type => "test",
element => "test"
};
push(@steps, $theAsserts);
}
$theAssertCount = 0;
# this is a new API section
$theAPI = $theString ;
$theAsserts->{$theAPI} = [ [] ] ;
$theType = "";
} else {
# this is a multi-row type
$theType = $theString;
$typeRows = $rows;
# print qq(Found multi-row $theString for $theAPI with $typeRows rows\n);
$typeRows--;
# populate the first cell
if ($theAPI
&& exists($theAsserts->{$theAPI}->[$theAssertCount])
&& scalar(@{$theAsserts->{$theAPI}->[$theAssertCount]})) {
$theAssertCount++;
}
$theAsserts->{$theAPI}->[$theAssertCount] = [ $theType ] ;
}
} elsif (m/^\|(.*)$/) {
my $item = $1;
$item =~ s/^ *//;
$item =~ s/ *$//;
$item =~ s/^['"]//;
$item =~ s/['"]$//;
# add into the data structure for the API
if (!exists $theAsserts->{$theAPI}->[$theAssertCount]) {
$theAsserts->{$theAPI}->[$theAssertCount] = [ $item ] ;
} else {
push(@{$theAsserts->{$theAPI}->[$theAssertCount]}, $item);
}
}
}
};
if ($state != 0) {
build_test($current, $theAttributes, $theCode, \@steps, $theSpecFragment) ;
print "Finished $current\n";
}
exit 0;
# build_test
#
# create a test file
#
# attempts to create unique test names
sub build_test() {
my $title = shift ;
my $attrs = shift ;
my $code = shift ;
my $steps = shift;
my $frag = shift ;
if ($title eq "") {
print STDERR "No name provided!";
return;
}
if ($frag ne "") {
$frag =~ s/%code%/$code/;
$code = $frag;
}
$code =~ s/ +$//m;
$code =~ s/\t/ /g;
my $title_reference = $title;
if ($code eq "") {
print STDERR "No code for $title; skipping.\n";
return;
}
if ( $steps eq {}) {
print STDERR "No assertions for $title; skipping.\n";
return;
}
my $testDef =
{ "title" => $title,
"steps" => []
};
my $stepCount = 0;
foreach my $asserts (@$steps) {
$stepCount++;
my $step =
{
"type" => $asserts->{"type"},
"title"=> "step " . $stepCount,
};
if ($asserts->{type} eq "test") {
# everything in the block is about testing an element
$step->{"element"} = ( $asserts->{"element"} || "test" );
my $tests = {};
if ($fake) {
$tests->{"WAIFAKE"} = [ [ "property", "role", "is", "ROLE_TABLE_CELL" ], [ "property", "interfaces", "contains", "TableCell" ] ];
}
foreach my $name (@apiNames) {
if (exists $asserts->{$name} && scalar(@{$asserts->{$name}})) {
$tests->{$name} = $asserts->{$name};
}
};
$step->{test} = $tests;
} elsif ($asserts->{type} eq "attribute") {
$step->{type} = "attribute";
$step->{element} = $asserts->{"element"};
$step->{attribute} = $asserts->{"attribute"};
$step->{value} = $asserts->{value};
} elsif ($asserts->{type} eq "event") {
$step->{type} = "event";
$step->{element} = $asserts->{"element"};
$step->{event} = $asserts->{value};
} else {
print STDERR "Invalid step type: " . $asserts->{type} . "\n";
next;
}
push(@{$testDef->{steps}}, $step);
}
# populate the rest of the test definition
if (scalar(keys(%$attrs))) {
while (my $key = each(%$attrs)) {
# print "Copying $key \n";
$testDef->{$key} = $attrs->{$key};
}
}
if (exists $attrs->{reference}) {
$title_reference = "" . $title_reference . "" ;
}
my $testDef_json = to_json($testDef, { canonical => 1, pretty => 1, utf8 => 1});
my $fileName = $title;
$fileName =~ s/\s*$//;
$fileName =~ s/\///g;
$fileName =~ s/\s+/_/g;
$fileName =~ s/[,=:]/_/g;
$fileName =~ s/['"]//g;
my $count = 2;
if ($testNames->{$fileName}) {
while (exists $testNames->{$fileName . "_$count"}) {
$count++;
}
$fileName .= "_$count";
}
$fileName = lc($fileName);
$testNames->{$fileName} = 1;
$fileName .= $theSuffix;
my $template = qq(
$title
This test examines the ARIA properties for $title_reference.
$code
);
my $file ;
if (open($file, ">", "$dir/$fileName")) {
print $file $template;
print $file "\n";
close $file;
} else {
print STDERR qq(Failed to create file "$dir/$fileName" $!\n);
}
return;
}
sub usage() {
print STDERR q(usage: make_tests.pl -f file | -w wiki_title | -s spec [-n -v -d dir ]
-s specname - the name of a spec known to the system
-w wiki_title - the TITLE of a wiki page with testable statements
-f file - the file from which to read
-n - do nothing
-v - be verbose
-d dir - put generated tests in directory dir
);
exit 1;
}
# vim: ts=2 sw=2 ai: