From 26a029d407be480d791972afb5975cf62c9360a6 Mon Sep 17 00:00:00 2001
From: Daniel Baumann <daniel.baumann@progress-linux.org>
Date: Fri, 19 Apr 2024 02:47:55 +0200
Subject: Adding upstream version 124.0.1.

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
---
 .../tests/wai-aria/tools/convert_wiki.pl           | 648 +++++++++++++++++++++
 .../tests/wai-aria/tools/make_tests.pl             | 544 +++++++++++++++++
 2 files changed, 1192 insertions(+)
 create mode 100644 testing/web-platform/tests/wai-aria/tools/convert_wiki.pl
 create mode 100644 testing/web-platform/tests/wai-aria/tools/make_tests.pl

(limited to 'testing/web-platform/tests/wai-aria/tools')

diff --git a/testing/web-platform/tests/wai-aria/tools/convert_wiki.pl b/testing/web-platform/tests/wai-aria/tools/convert_wiki.pl
new file mode 100644
index 0000000000..d3415f2653
--- /dev/null
+++ b/testing/web-platform/tests/wai-aria/tools/convert_wiki.pl
@@ -0,0 +1,648 @@
+#!/usr/bin/perl
+#
+#  convert_wiki.pl - Transform an old-style wiki into the new format
+#
+#  This script assumes that a wiki has testable statement entries
+#  with varying lemgth lines. Those lines will be converted into
+#  the format described by the specification at
+#  https://spec-ops.github.io/atta-api/index.html
+#
+#  usage: convert_wiki.pl -f file | -w wiki_title -o outFile
+
+use strict;
+
+use IO::String ;
+use JSON ;
+use MediaWiki::API ;
+use Getopt::Long;
+
+my @apiNames = qw(UIA MSAA ATK IAccessible2 AXAPI);
+
+# dir is determined based upon the short name of the spec and is defined
+# by the input or on the command line
+
+my $file = undef ;
+my $spec = undef ;
+my $wiki_title = undef ;
+my $dir = undef;
+my $outFile = undef;
+
+my $result = GetOptions(
+    "f|file=s"   => \$file,
+    "w|wiki=s"   => \$wiki_title,
+    "s|spec=s"   => \$spec,
+    "o|output=s"   => \$outFile);
+
+my $wiki_config = {
+  "api_url" => "https://www.w3.org/wiki/api.php"
+};
+
+my %specs = (
+    "aria11" => {
+      title => "ARIA_1.1_Testable_Statements",
+      specURL => "https://www.w3.org/TR/wai-aria11"
+    },
+    "svg" => {
+      title => "SVG_Accessibility/Testing/Test_Assertions_with_Tables_for_ATTA",
+      specURL => "https://www.w3.org/TR/svg-aam-1.0/"
+    }
+);
+
+my $io ;
+our $theSpecURL = "";
+
+if ($spec) {
+  $wiki_title = $specs{$spec}->{title};
+  $theSpecURL = $specs{$spec}->{specURL};
+}
+
+if ($wiki_title) {
+  my $MW = MediaWiki::API->new( $wiki_config );
+  my $page = $MW->get_page( { title => $wiki_title } );
+  my $theContent = $page->{'*'};
+  $io = IO::String->new($theContent);
+} elsif ($file) {
+  open($io, "<", $file) || die("Failed to open $file: " . $@);
+} else {
+  usage() ;
+}
+
+my $outH ;
+if (defined $outFile) {
+  open($outH, ">", $outFile) || die("Failed to create file $outFile: $@");
+} else {
+  $outH = new IO::Handle;
+  $outH->fdopen(fileno(STDOUT), "w");
+}
+
+
+# Now let's walk through the content and spit it back out
+# transformed
+#
+
+# iterate over the content
+
+# my $io ;
+# open($io, "<", "raw") ;
+
+my $state = 0;   # between items
+my $theCode = "";
+my $theAttributes = {};
+my $theAsserts = {} ;
+my $theAssertCount = 0;
+my $theAPI = "";
+my $typeRows = 0;
+my $theType = "";
+my $theName = "";
+my $theRef = "";
+
+my $before = "" ;
+my $after = "" ;
+
+my @errors = () ;
+my $linecount = 0;
+
+while (<$io>) {
+  $linecount++;
+  # look for state
+  if ($state == 0) {
+    if (scalar(keys(%$theAsserts))) {
+      # we were in an item; dump it
+      print $outH  dump_table($theAsserts) ;
+      $theAsserts = {};
+    }
+    print $outH $_;
+  }
+  if (m/^\{\|/) {
+    # table started
+    $state = 4;
+    $theAPI = "";
+  }
+  if ($state == 4) {
+    if (m/^\|-/) {
+      if ($theAPI
+          && exists($theAsserts->{$theAPI}->[$theAssertCount])
+          && scalar(@{$theAsserts->{$theAPI}->[$theAssertCount]})) {
+        $theAssertCount++;
+      }
+      # start of a table row
+      if ($theType ne "" && $typeRows) {
+        # 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 = 0;
+    } elsif (m/^\|rowspan="*([0-9])"*\|(.*)$/) {
+      # someone put a rowspan in here..  is ht an API?
+      my $rows = $1;
+      my $theString = $2;
+      $theString =~ s/ +$//;
+      $theString =~ s/^ +//;
+      $theString = "IAccessible2" if ($theString eq "IA2") ;
+      if (grep { $_ eq $theString } @apiNames) {
+        $theAssertCount = 0;
+        # this is a new API section
+        $theAPI = $theString ;
+        $theAsserts->{$theAPI} = [ [] ] ;
+        $theType = "";
+      } else {
+        # nope, this is a multi-row type
+        $theType = $theString;
+        $typeRows = $rows;
+        $typeRows--;
+        # populate the first cell
+        if ($theAPI
+            && exists($theAsserts->{$theAPI}->[$theAssertCount])
+            && scalar(@{$theAsserts->{$theAPI}->[$theAssertCount]})) {
+          $theAssertCount++;
+        }
+        $theAsserts->{$theAPI}->[$theAssertCount] = [ $theType ] ;
+      }
+    } elsif (m/^\|note/) {
+      # there is a note in the table...  throw it out
+      # and the next line too
+      my $l = <$io>;
+    } elsif (m/^\|(MSAA|UIA|IA2|IAccessible2|ATK|AXAPI) *$/) {
+      # they FORGOT a rowspan on an API.  That means there is only 1
+      # row
+      my $theString = $1;
+      $theString =~ s/ +$//;
+      $theString =~ s/^ +//;
+      $theString = "IAccessible2" if ($theString eq "IA2") ;
+      if (grep { $_ eq $theString } @apiNames) {
+        $theAssertCount = 0;
+        # this is a new API section
+        $theAPI = $theString ;
+        $theAsserts->{$theAPI} = [ [] ] ;
+        $theType = "";
+      } else {
+        push(@errors, "Bad API Name at $linecount: $theString");
+      }
+    } 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);
+      }
+    }
+    next;
+  }
+};
+
+if ($state == 0) {
+  if (scalar(keys(%$theAsserts))) {
+    # we were in an item; dump it
+    print $outH  dump_table($theAsserts) ;
+  }
+}
+
+if (@errors) {
+  print "There were the following errors:\n";
+  foreach my $err (@errors) {
+    print $err . "\n";
+  }
+}
+
+exit 0;
+
+
+sub dump_table() {
+  my $asserts = shift;
+
+  if (!scalar(keys(%$asserts)) )  {
+    # no actual assertions
+    return "";
+  }
+
+  my $output = "" ;
+
+  my @keywords = qw(property result event);
+
+  foreach my $API (sort(keys(%$asserts))) {
+    # looking at each API in turn
+    my $ref = $asserts->{$API};
+    my $rowcount = scalar(@$ref) ;
+    # $output .= "|-\n|rowspan=$count|$API\n" ;
+    # now we are in the assertions; special case each API
+    my @conditions = @$ref;
+    for (my $i = 0; $i < scalar(@conditions); $i++) {
+      my (@new, @additional) ;
+      if ($i) {
+        $output .= "|-\n";
+      }
+      if ($API eq "ATK") {
+        my $start = 0;
+        my $assert = "is";
+        if ($conditions[$i]->[0] =~ m/^NOT/) {
+          $start = 1;
+          $assert = "isNot";
+        }
+
+        if ($conditions[$i]->[$start] =~ m/^ROLE_/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start];
+        } elsif ($conditions[$i]->[$start] =~ m/^xml-roles/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/^description/) {
+          my $id = $conditions[$i]->[$start+1];
+          $new[0] = "property";
+          $new[1] = "description";
+          $new[2] = $assert;
+          $new[3] = $id;
+          push(@{$additional[0]}, ("relation", "RELATION_DESCRIBED_BY", $assert, $id));
+          push(@{$additional[1]}, ("relation", "RELATION_DESCRIPTION_FOR", $assert, "test"));
+        } elsif ($conditions[$i]->[$start] =~ m/not in accessibility tree/i) {
+          @new = qw(property accessible exists false);
+        } elsif ($conditions[$i]->[$start] =~ m/^RELATION/) {
+          $new[0] = "relation";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/(.*) interface/i) {
+          $new[0] = "property";
+          $new[1] = "interfaces";
+          $new[3] = $1;
+          if ($conditions[$i]->[$start+1] ne '<shown>'
+            && $conditions[$i]->[$start+1] !~ m/true/i ) {
+            $assert = "doesNotContain";
+          } else {
+            $assert = "contains";
+          }
+          $new[2] = $assert;
+        } elsif ($conditions[$i]->[$start] eq "object" || $conditions[$i]->[$start] eq "attribute" ) {
+          $new[0] = "property";
+          $new[1] = "objectAttributes";
+          my $val = $conditions[$i]->[2];
+          $val =~ s/"//g;
+          $new[3] = $conditions[$i]->[1] . ":" . $val;
+          if ($conditions[$i]->[1] eq "not exposed"
+            || $conditions[$i]->[2] eq "false") {
+            $new[2] = "doesNotContain";
+          } else {
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^STATE_/) {
+          $new[0] = "property";
+          $new[1] = "states";
+          $new[3] = $conditions[$i]->[$start];
+          if ($assert eq "true") {
+            $new[2] = "contains";
+          } else {
+            $new[2] = "doesNotContain";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^object attribute (.*)/) {
+          my $name = $1;
+          $new[0] = "property";
+          $new[0] = "objectAttributes";
+          my $val = $conditions[$i]->[1];
+          $val =~ s/"//g;
+          if ($val eq "not exposed" || $val eq "not mapped") {
+            $new[3] = $name;
+            $new[2] = "doesNotContain";
+          } else {
+            $new[3] = $name . ":" . $val;
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^name/) {
+          my $name = $conditions[$i]->[1];
+          my $cond = "is" ;
+          if ($name eq "<empty>" ) {
+            $cond = "empty";
+            $name = "true"
+          } elsif ($name eq "<not empty>") {
+            $cond = "empty";
+            $name = "false";
+          }
+          $new[0] = "property";
+          $new[1] = "name";
+          $new[2] = $cond;
+          $new[3] = $name;
+        } else {
+          @new = @{$conditions[$i]};
+          if ($conditions[$i]->[2] eq '<shown>') {
+            $new[2] = "contains";
+          }
+        }
+        $conditions[$i] = \@new;
+      } elsif ($API eq "UIA") {
+        my $start = 0;
+        my $assert = "is";
+        if ($conditions[$i]->[$start] =~ m/\./) {
+          my $val = $conditions[$i]->[$start+1];
+          $val =~ s/"//g;
+          $val =~ s/'//g;
+          $new[0] = "result";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/not in accessibility tree/i) {
+          @new = qw(property accessible exists false);
+        } elsif ($conditions[$i]->[$start] =~ m/^(AriaProperties|Toggle|ExpandCollapse)/) {
+          my $name = $conditions[$i]->[1];
+          $new[0] = "property";
+          $new[1] = $1;
+          my $val = $conditions[$i]->[2];
+          $val =~ s/"//g;
+          if ($val eq "not exposed" || $val eq "not mapped") {
+            $new[3] = $name;
+            $new[2] = "doesNotContain";
+          } else {
+            $new[3] = $name . ":" . $val;
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^LabeledBy/i) {
+          $new[0] = "property";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/^Name/) {
+          my $name = $conditions[$i]->[1];
+          my $cond = "is" ;
+          if ($name eq "<empty>" ) {
+            $cond = "empty";
+            $name = "true"
+          } elsif ($name eq "<not empty>") {
+            $cond = "empty";
+            $name = "false";
+          }
+          $new[0] = "property";
+          $new[1] = "Name";
+          $new[2] = $cond;
+          $new[3] = $name;
+        } elsif ($conditions[$i]->[$start] =~ m/^TBD/) {
+          $new[0] = "TBD";
+          $new[1] = $new[2] = $new[3] = "";
+        } else {
+          if ($conditions[$i]->[1] ne '<shown>'
+            && $conditions[$i]->[1] !~ m/true/i ) {
+            $assert = "isNot";
+          } else {
+            $assert = "is";
+          }
+          $new[0] = "property";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        }
+      } elsif ($API eq "MSAA") {
+        my $start = 0;
+        my $assert = "is";
+        if ($conditions[$i]->[0] =~ m/^NOT/) {
+          $start = 1;
+          $assert = "isNot";
+        }
+
+        if ($conditions[$i]->[$start] =~ m/^role/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/^xml-roles/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/not in accessibility tree/i) {
+          @new = qw(property accessible exists false);
+        } elsif ($conditions[$i]->[$start] =~ m/^(accName|accDescription)/) {
+          my $name = $conditions[$i]->[$start+1];
+          my $cond = "is" ;
+          if ($name eq "<empty>" ) {
+            $cond = "empty";
+            $name = "true"
+          } elsif ($name eq "<not empty>") {
+            $cond = "empty";
+            $name = "false";
+          }
+          $new[0] = "property";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $cond;
+          $new[3] = $name;
+        } elsif ($conditions[$i]->[$start] =~ m/^ROLE_/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start];
+        } elsif ($conditions[$i]->[$start] =~ m/^(STATE_.*) *([^ ]*)/) {
+          $new[0] = "property";
+          $new[1] = "states";
+          $new[3] = $1;
+          if ($2 && $2 eq "cleared") {
+            print "MATCHED $1, $2\n";
+            $new[2] = "doesNotContain";
+          } else {
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^TBD/) {
+          $new[0] = "TBD";
+          $new[1] = $new[2] = $new[3] = "";
+        }
+      } elsif ($API eq "IAccessible2") {
+        my $start = 0;
+        my $assert = "is";
+        if ($conditions[$i]->[0] =~ m/^NOT/) {
+          $start = 1;
+          $assert = "isNot";
+        }
+        if ($conditions[$i]->[$start] =~ m/^IA2_ROLE_/) {
+          $new[0] = "property";
+          $new[1] = "role";
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start];
+        } elsif ($conditions[$i]->[$start] =~ m/not in accessibility tree/i) {
+          @new = qw(property accessible exists false);
+        } elsif ($conditions[$i]->[$start] =~ m/^IA2_RELATION_/) {
+          $new[0] = "relation";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/^IA2_STATE_/) {
+          $new[0] = "property";
+          $new[1] = "states";
+          $new[3] = $conditions[$i]->[$start];
+          if ($assert eq "true") {
+            $new[2] = "contains";
+          } else {
+            $new[2] = "doesNotContain";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^IA2_/) {
+          $new[0] = "property";
+          $new[1] = "states";
+          $new[3] = $conditions[$i]->[$start];
+          if ($assert eq "true") {
+            $new[2] = "contains";
+          } else {
+            $new[2] = "doesNotContain";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/(IAccessibleTable2)/i) {
+          $new[0] = "property";
+          $new[1] = "interfaces";
+          $new[3] = $1;
+          if ($conditions[$i]->[$start+1] ne '<shown>'
+            && $conditions[$i]->[$start+1] !~ m/true/i ) {
+            $assert = "doesNotContain";
+          } else {
+            $assert = "contains";
+          }
+          $new[2] = $assert;
+        } elsif ($conditions[$i]->[$start] =~ m/(.*) interface/i) {
+          $new[0] = "property";
+          $new[1] = "interfaces";
+          $new[3] = $1;
+          if ($conditions[$i]->[$start+1] ne '<shown>'
+            && $conditions[$i]->[$start+1] !~ m/true/i ) {
+            $assert = "doesNotContain";
+          } else {
+            $assert = "contains";
+          }
+          $new[2] = $assert;
+        } elsif ($conditions[$i]->[$start] =~ m/(.*)\(\)/) {
+          $new[0] = "result";
+          $new[1] = $conditions[$i]->[$start];
+          my $val = $conditions[$i]->[2];
+          $val =~ s/"//g;
+          $new[3] = $conditions[$i]->[1] . ":" . $val;
+          if ($conditions[$i]->[1] eq "not exposed"
+            || $conditions[$i]->[2] eq "false") {
+            $new[2] = "doesNotContain";
+          } else {
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/(.*localizedExtendedRole)/) {
+          $new[0] = "result";
+          $new[1] = $conditions[$i]->[$start];
+          my $val = $conditions[$i]->[2];
+          $val =~ s/"//g;
+          $new[3] = $conditions[$i]->[1] . ":" . $val;
+          if ($conditions[$i]->[1] eq "not exposed"
+            || $conditions[$i]->[2] eq "false") {
+            $new[2] = "doesNotContain";
+          } else {
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] eq "object" || $conditions[$i]->[$start] eq "attribute" ) {
+          $new[0] = "property";
+          $new[1] = "objectAttributes";
+          my $val = $conditions[$i]->[2];
+          $val =~ s/"//g;
+          $new[3] = $conditions[$i]->[1] . ":" . $val;
+          if ($conditions[$i]->[1] eq "not exposed"
+            || $conditions[$i]->[2] eq "false") {
+            $new[2] = "doesNotContain";
+          } else {
+            $new[2] = "contains";
+          }
+        } elsif ($conditions[$i]->[$start] =~ m/^object attribute (.*)/) {
+          my $name = $1;
+          $new[0] = "property";
+          $new[1] = "objectAttributes";
+          my $val = $conditions[$i]->[1];
+          $val =~ s/"//g;
+          if ($val eq "not exposed" || $val eq "not mapped") {
+            $new[3] = $name;
+            $new[2] = "doesNotContain";
+          } else {
+            $new[3] = $name . ":" . $val;
+            $new[2] = "contains";
+          }
+        } else {
+          @new = @{$conditions[$i]};
+          if ($conditions[$i]->[2] eq '<shown>') {
+            $new[2] = "contains";
+          }
+        }
+        $conditions[$i] = \@new;
+      } elsif ($API eq "AXAPI") {
+        my $start = 0;
+        my $assert = "is";
+        if ($conditions[$i]->[0] =~ m/^NOT/) {
+          $start = 1;
+          $assert = "isNot";
+        }
+        if ($conditions[$i]->[$start] =~ m/^AXElementBusy/) {
+          if ($conditions[$i]->[$start+1] =~ m/yes/i) {
+            $new[3] = "true";
+          } else {
+            $new[3] = "false";
+          }
+          $new[0] = "property";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+        } elsif ($conditions[$i]->[$start] =~ m/not in accessibility tree/i) {
+          @new = qw(property accessible exists false);
+        } elsif ($conditions[$i]->[$start] =~ m/^AX/) {
+          $new[0] = "property";
+          $new[1] = $conditions[$i]->[$start];
+          $new[2] = $assert;
+          $new[3] = $conditions[$i]->[$start+1];
+        } elsif ($conditions[$i]->[$start] =~ m/^TBD/) {
+          $new[0] = "TBD";
+          $new[1] = $new[2] = $new[3] = "";
+        } else {
+          if ($conditions[$i]->[1] ne '<shown>'
+            && $conditions[$i]->[1] !~ m/true/i ) {
+            $assert = "isNot";
+          } else {
+            $assert = "is";
+          }
+          $new[0] = "result";
+          $new[1] = $conditions[$i]->[0];
+          $new[2] = $assert;
+          $new[3] = "true";
+        }
+      }
+      if ($i == 0) {
+        if (scalar(@additional)) {
+          $rowcount += scalar(@additional);
+        }
+        $output .= "|-\n|rowspan=$rowcount|$API\n";
+      }
+      foreach my $row (@new) {
+        $output .= "|$row\n";
+      }
+      if (scalar(@additional)) {
+        foreach my $arow (@additional) {
+          $output .= "|-\n" ;
+          foreach my $aItem (@$arow) {
+            $output .= "|$aItem\n";
+          }
+        }
+      }
+    }
+  }
+  $output .= "|}\n";
+
+  return $output;
+}
+
+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
+  -o outFile    - the file to fill with  the converted wiki; defaults to STDOUT
+
+  -n            - do nothing
+  -v            - be verbose
+  );
+  exit 1;
+}
+
+# vim: ts=2 sw=2 ai:
diff --git a/testing/web-platform/tests/wai-aria/tools/make_tests.pl b/testing/web-platform/tests/wai-aria/tools/make_tests.pl
new file mode 100644
index 0000000000..01cb5b0b85
--- /dev/null
+++ b/testing/web-platform/tests/wai-aria/tools/make_tests.pl
@@ -0,0 +1,544 @@
+#!/usr/bin/perl
+#
+#  make_tests.pl - generate WPT test cases from the testable statements wiki
+#
+#  This script assumes that a wiki has testable statement entries
+#  in the format described by the specification at
+#  https://spec-ops.github.io/atta-api/index.html
+#
+#  usage: make_tests.pl -f file | -w wiki_title | -s spec -d dir
+
+use strict;
+
+use IO::String ;
+use JSON ;
+use MediaWiki::API ;
+use Getopt::Long;
+
+my %specs = (
+    "aria11" => {
+      title => "ARIA_1.1_Testable_Statements",
+      specURL => "https://www.w3.org/TR/wai-aria11/",
+      dir => "aria11"
+    },
+    "svg" => {
+      title => "SVG_Accessibility/Testing/Test_Assertions_with_Tables_for_ATTA",
+      specURL => "https://www.w3.org/TR/svg-aam-1.0/",
+      dir => "svg",
+      fragment => '<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">%code%</svg>'
+    }
+);
+
+my @apiNames = qw(UIA MSAA ATK IAccessible2 AXAPI);
+my $apiNamesRegex = "(" . join("|", @apiNames) . ")";
+
+# the suffix to attach to the automatically generated test case names
+my $theSuffix = "-manual.html";
+
+# dir is determined based upon the short name of the spec and is defined
+# by the input or on the command line
+
+my $file = undef ;
+my $spec = undef ;
+my $wiki_title = undef ;
+my $dir = undef;
+my $theSpecFragment = "%code%";
+my $preserveWiki = "";
+my $fake = 0;
+
+my $result = GetOptions(
+    "f|file=s"   => \$file,
+    "p=s" => \$preserveWiki,
+    "w|wiki=s"   => \$wiki_title,
+    "s|spec=s"   => \$spec,
+    "f|fake"    => \$fake,
+    "d|dir=s"   => \$dir) || usage();
+
+my $wiki_config = {
+  "api_url" => "https://www.w3.org/wiki/api.php"
+};
+
+my $io ;
+our $theSpecURL = "";
+
+if ($spec) {
+  print "Processing spec $spec\n";
+  $wiki_title = $specs{$spec}->{title};
+  $theSpecURL = $specs{$spec}->{specURL};
+  if (!$dir) {
+    $dir = "../" . $specs{$spec}->{dir};
+  }
+  $theSpecFragment = $specs{$spec}->{fragment};
+}
+
+if (!$dir) {
+  $dir = "../raw";
+}
+
+if (!-d $dir) {
+  print STDERR "No such directory: $dir\n";
+  exit 1;
+}
+
+if ($file) {
+  open($io, "<", $file) || die("Failed to open $file: " . $@);
+} elsif ($wiki_title) {
+  my $MW = MediaWiki::API->new( $wiki_config );
+
+  $MW->{config}->{on_error} = \&on_error;
+
+  sub on_error {
+    print "Error code: " . $MW->{error}->{code} . "\n";
+    print $MW->{error}->{stacktrace}."\n";
+    die;
+  }
+  my $page = $MW->get_page( { title => $wiki_title } );
+  my $theContent = $page->{'*'};
+  print "Loaded " . length($theContent) . " from $wiki_title\n";
+  if ($preserveWiki) {
+    if (open(OUTPUT, ">$preserveWiki")) {
+      print OUTPUT $theContent;
+      close OUTPUT;
+      print "Wiki preserved in $preserveWiki\n";
+      exit 0;
+    } else {
+      print "Failed to create $preserveWiki. Terminating.\n";
+      exit 1;
+    }
+  }
+  $io = IO::String->new($theContent);
+} else {
+  usage() ;
+}
+
+
+
+# Now let's walk through the content and build a test page for every item
+#
+
+# iterate over the content
+
+# my $io ;
+# open($io, "<", "raw") ;
+
+# data structure:
+#
+# steps is a list of steps to be performed.
+# Each step is an object that has a type property and other properties based upon that type.
+#
+# Types include:
+#
+# 'test' - has a property for each ATAPI for which there are tests
+# 'attribute' - has a property for the target id, attribute name, and value
+# 'event' - has a property for the target id and event name
+my $state = 0;   # between items
+my $theStep = undef;
+my $current = "";
+my $theCode = "";
+my $theAttributes = {};
+my @steps ;
+my $theAsserts = {} ;
+my $theAssertCount = 0;
+my $theAPI = "";
+my $typeRows = 0;
+my $theType = "";
+my $theName = "";
+my $theRef = "";
+my $lineCounter = 0;
+my $skipping = 0;
+
+our $testNames = {} ;
+
+while (<$io>) {
+  if (m/<!-- END OF TESTS -->/) {
+    last;
+  }
+  $lineCounter++;
+  # look for state
+  if (m/^SpecURL: (.*)$/) {
+    $theSpecURL = $1;
+    $theSpecURL =~ s/^ *//;
+    $theSpecURL =~ s/ *$//;
+  }
+  if ($state == 5 && m/^; \/\/ (.*)/) {
+    # we found another test inside a block
+    # we were in an item; dump it
+    build_test($current, $theAttributes, $theCode, \@steps, $theSpecFragment) ;
+    # print "Finished $current and new subblock $1\n";
+    $state = 1;
+    $theAttributes = {} ;
+    $theAPI = "";
+    @steps = ();
+    $theCode = "";
+    $theAsserts = undef;
+    $theName = "";
+  } elsif (m/^=== +(.*[^ ]) +===/) {
+    if ($state != 0) {
+      if ($skipping) {
+        print STDERR "Flag on assertion $current; skipping\n";
+      } else {
+        # we were in an item; dump it
+        build_test($current, $theAttributes, $theCode, \@steps, $theSpecFragment) ;
+        # print "Finished $current\n";
+      }
+    }
+    $state = 1;
+    $current = $1;
+    $theAttributes = {} ;
+    @steps = ();
+    $theCode = "";
+    $theAsserts = undef;
+    $theAPI = "";
+    $theName = "";
+    if ($current =~ m/\(/) {
+      # there is a paren in the name -skip it
+      $skipping = 1;
+    } else {
+      $skipping = 0;
+    }
+  }
+
+  if ($state == 1) {
+    if (m/<pre>/) {
+      # 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 "&amp;&" for the "&" character. We need to undo that.
+        $theCode =~ s/&amp;(\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 = "<a href='" . $attrs->{reference} . "'>" . $title_reference . "</a>" ;
+  }
+
+  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(<!doctype html>
+<html>
+  <head>
+    <title>$title</title>
+    <meta content="text/html; charset=utf-8" http-equiv="Content-Type"/>
+    <link rel="stylesheet" href="/wai-aria/scripts/manual.css">
+    <script src="/resources/testharness.js"></script>
+    <script src="/resources/testharnessreport.js"></script>
+    <script src="/wai-aria/scripts/ATTAcomm.js"></script>
+    <script>
+    setup({explicit_timeout: true, explicit_done: true });
+
+    var theTest = new ATTAcomm(
+    $testDef_json
+    ) ;
+    </script>
+  </head>
+  <body>
+  <p>This test examines the ARIA properties for $title_reference.</p>
+  $code
+  <div id="manualMode"></div>
+  <div id="log"></div>
+  <div id="ATTAmessages"></div>
+  </body>
+</html>);
+
+  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:
-- 
cgit v1.2.3