Perl 6 port of TestML is complete.

Passing entire test suite.

lib/TestML/Parser.pm

@@ -172,3 +172,9 @@ method data_block($/) {
     $doc.data.blocks.push($block);
 }
 
+method SEMICOLON_ERROR($/) {
+    die "You seem to be missing a semicolon";
+}
+method NO_META_TESTML_ERROR($/) {
+    die "No TestML meta directive found";
+}

lib/TestML/Parser/Grammar.pm

@@ -3,7 +3,7 @@ grammar TestML::Parser::Grammar::Base;
 
 regex ALWAYS    { <?>               } # Always match
 regex ANY       { .                 } # Any unicode character
-regex SPACE     { <[\ \t]>          } # A space or tab character
+regex SPACE     { <blank>           } # A space or tab character
 regex BREAK     { \n                } # A newline character
 regex EOL       { \r? \n            } # A Unix or DOS line ending
 regex NON_BREAK { \N                } # Any character except newline
@@ -90,7 +90,7 @@ rule document {
 #------------------------------------------------------------------------------#
 rule meta_section {
     [ <comment> | <blank_line> ]*
-    <meta_testml_statement>
+    [ <meta_testml_statement> | <NO_META_TESTML_ERROR> ]
     [ <meta_statement> | <comment> | <blank_line> ]*
 }
 
@@ -132,7 +132,7 @@ token test_statement {
     <test_statement_start>
     <test_expression>
     <assertion_call>?
-    ';'
+    [ ';' | <SEMICOLON_ERROR> ]
 }
 
 token test_statement_start {
@@ -231,6 +231,9 @@ token data_section {
     <ANY>*
 }
 
+token SEMICOLON_ERROR { <ALWAYS> }
+token NO_META_TESTML_ERROR { <ALWAYS> }
+
 
 #------------------------------------------------------------------------------#
 grammar TestML::Parser::Grammar::DataSection is TestML::Parser::Grammar::Base;

lib/TestML/Runner.pm

@@ -19,8 +19,7 @@ method run () {
     $.title();
     $.plan_begin();
 
-#     use YAML;
-#     die dump($.doc.test.statements[0]);
+    use XXX;
     for $.doc.test.statements -> $statement {
         my @blocks = $statement.points.elems
             ?? $.select_blocks($statement.points)
@@ -71,9 +70,9 @@ method evaluate_expression ($expression, $block) {
 
     for $expression.transforms -> $transform {
         my $transform_name = $transform.name;
-#         next if $context.error and $transform_name ne 'Catch';
+        next if $context.error and $transform_name ne 'Catch';
         my $function = $.get_transform_function($transform_name);
-        {
+        try {
             $context.value = $function(
                 $context, 
                 | $transform.args.map({
@@ -83,10 +82,10 @@ method evaluate_expression ($expression, $block) {
                 })
             );
 
-#             CATCH {
-#                 $context.error($!);
-#                 $context.value = Nil;
-#             }
+            CATCH {
+                $context.error = "$!";
+                $context.value = Nil;
+            }
         }
     }
 

lib/TestML/Standard.pm

@@ -40,6 +40,14 @@ our sub Item ($this) {
     return @list.join("\n");
 }
 
+our sub Catch ($this) {
+    my $error = $this.error
+        or die "Catch called but no TestML error found";
+#     $error ~~ s/' at ' .* ' line ' \d+ '.' \n $//;
+    $this.error = Nil;
+    return $error;
+}
+
 # sub Select () {
 #     return (shift).value;
 # }
@@ -50,14 +58,6 @@ our sub Item ($this) {
 #     return this.block.points{$point};
 # }
 # 
-# sub Catch () {
-#     my $error = this.error
-#         or die "Catch called but no TestML error found";
-#     $error ~~ s/' at ' .* ' line ' \d+ '.' \n $//;
-#     this.error(Nil);
-#     return $error;
-# }
-# 
 # multi sub Throw ($msg) {
 #     fail $msg;
 # }

t/Bridge.pm

@@ -14,3 +14,12 @@ our sub my_thing($this) {
 our sub combine($this, $suffix) {
     return $this.value ~ ' ' ~ $suffix.value;
 }
+
+our sub parse_testml($this) {
+    eval "use TestML::Parser";
+    TestML::Parser.parse($this.value);
+}
+
+our sub msg($this) {
+    return $this.value;
+}

t/error.t

@@ -0,0 +1,6 @@
+use TestML::Runner::TAP;
+
+TestML::Runner::TAP.new(
+    document => 'testml-tml/error.tml',
+    bridge => 'Bridge',
+).run();