Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Make it compile on current Rakudo #1

Open
wants to merge 1 commit into from

2 participants

@moritz

plus some small obvious fixes (supplied missing panic method, update to exception handling).

Now the tests die with "No TestML meta directive found", but at least the modules can be loaded.

@moritz moritz make it compile on rakudo again
also a small update to exception handling
ea57e74
@Mouq

Bumping this

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on May 24, 2012
  1. @moritz

    make it compile on rakudo again

    moritz authored
    also a small update to exception handling
This page is out of date. Refresh to see the latest.
View
87 lib/TestML/Document.pm
@@ -8,65 +8,66 @@ class TestML::Assertion { ... }
class TestML::Document::Data { ... }
#-----------------------------------------------------------------------------
-class TestML::Document;
-
-has $.meta = TestML::Document::Meta.new;
-has $.test = TestML::Document::Tests.new;
-has $.data = TestML::Document::Data.new;
+class TestML::Document {
+ has $.meta = TestML::Document::Meta.new;
+ has $.test = TestML::Document::Tests.new;
+ has $.data = TestML::Document::Data.new;
+}
#-----------------------------------------------------------------------------
-class TestML::Document::Meta;
-
-has $.data = {
- TestML => '',
- Data => [],
- Title => '',
- Plan => 0,
- BlockMarker => '===',
- PointMarker => '---',
-};
+class TestML::Document::Meta {
+ has $.data = {
+ TestML => '',
+ Data => [],
+ Title => '',
+ Plan => 0,
+ BlockMarker => '===',
+ PointMarker => '---',
+ };
+}
#-----------------------------------------------------------------------------
-class TestML::Document::Tests;
-
-has $.statements = [];
+class TestML::Document::Tests {
+ has $.statements = [];
+}
#-----------------------------------------------------------------------------
-class TestML::Statement;
-
-has $.expression = TestML::Expression.new;
-has $.assertion is rw;
-has $.points = [];
+class TestML::Statement {
+ has $.expression = TestML::Expression.new;
+ has $.assertion is rw;
+ has $.points = [];
+}
#-----------------------------------------------------------------------------
-class TestML::Expression;
-
-has $.transforms = [];
+class TestML::Expression {
+ has $.transforms = [];
+}
#-----------------------------------------------------------------------------
-class TestML::Assertion;
-
-has $.name is rw;
-has $.expression = TestML::Expression.new;
+class TestML::Assertion {
+ has $.name is rw;
+ has $.expression = TestML::Expression.new;
+}
#-----------------------------------------------------------------------------
-class TestML::Transform;
-
-has $.name;
-has $.args;
+class TestML::Transform {
+ has $.name;
+ has $.args;
+}
#-----------------------------------------------------------------------------
-class TestML::String is TestML::Transform;
-
-has $.value;
+class TestML::String is TestML::Transform {
+ has $.value;
+}
#-----------------------------------------------------------------------------
-class TestML::Document::Data;
-
-has $.blocks = [];
+class TestML::Document::Data {
+ has $.blocks = [];
+}
#-----------------------------------------------------------------------------
-class TestML::Block;
+class TestML::Block {
+ has $.label is rw = '';
+ has $.points = {};
+}
-has $.label is rw = '';
-has $.points = {};
View
278 lib/TestML/Parser.pm
@@ -5,184 +5,186 @@ class TestML::Parser::Actions { ... }
use TestML::Parser::Grammar;
use TestML::Document;
-class TestML::Parser;
-
my $document;
my $data;
my $statement;
my $transform_arguments;
my @expression_stack;
-method parse($testml) {
- $document = TestML::Document.new();
- @expression_stack = ();
- TestML::Parser::Grammar.parse(
- $testml,
- :rule('document'),
- :actions(TestML::Parser::Actions),
- ) or die "Parse TestML failed";
- return $document;
-}
+class TestML::Parser {
+
+ method parse($testml) {
+ $document = TestML::Document.new();
+ @expression_stack = ();
+ TestML::Parser::Grammar.parse(
+ $testml,
+ :rule('document'),
+ :actions(TestML::Parser::Actions),
+ ) or die "Parse TestML failed";
+ return $document;
+ }
-method parse_data ($parser) {
- my $builder = $parser.receiver;
- my $document = $builder.document;
- for $document.meta.data<Data> -> $file {
- if $file eq '_' {
- $parser.stream($builder.inline_data);
- }
- else {
- $parser.open("self.base/$file");
+ method parse_data ($parser) {
+ my $builder = $parser.receiver;
+ my $document = $builder.document;
+ for $document.meta.data<Data> -> $file {
+ if $file eq '_' {
+ $parser.stream($builder.inline_data);
+ }
+ else {
+ $parser.open("self.base/$file");
+ }
+ $parser.parse;
+ $document.data.blocks.push(|$parser.receiver.blocks);
}
- $parser.parse;
- $document.data.blocks.push(|$parser.receiver.blocks);
}
}
#------------------------------------------------------------------------------#
-class TestML::Parser::Actions;
+class TestML::Parser::Actions {
-### Base Section ###
-method quoted_string($/) {
- make ~$/.substr(1, -1);
-}
+ ### Base Section ###
+ method quoted_string($/) {
+ make ~$/.substr(1, -1);
+ }
-method unquoted_string($/) {
- make ~$/;
-}
+ method unquoted_string($/) {
+ make ~$/;
+ }
-method dq_string($/) { make ~$/ }
+ method dq_string($/) { make ~$/ }
-method dq_escape($/) {
- my %h = '\\' => "\\",
- 'n' => "\n",
- 't' => "\t",
- 'f' => "\f",
- 'r' => "\r";
- make %h{~$/};
-}
+ method dq_escape($/) {
+ my %h = '\\' => "\\",
+ 'n' => "\n",
+ 't' => "\t",
+ 'f' => "\f",
+ 'r' => "\r";
+ make %h{~$/};
+ }
-method sq_string($/) { make ~$/ }
+ method sq_string($/) { make ~$/ }
-method sq_escape($/) {
- my %h = '\\' => "\\",
- make %h{~$/};
-}
+ method sq_escape($/) {
+ my %h = '\\' => "\\",
+ make %h{~$/};
+ }
-### Meta Section ###
-method meta_section($/) {
- $TestML::Parser::Grammar::block_marker = $document.meta.data<BlockMarker>;
- $TestML::Parser::Grammar::point_marker = $document.meta.data<PointMarker>;
-}
+ ### Meta Section ###
+ method meta_section($/) {
+ $TestML::Parser::Grammar::block_marker = $document.meta.data<BlockMarker>;
+ $TestML::Parser::Grammar::point_marker = $document.meta.data<PointMarker>;
+ }
-method meta_testml_statement($/) {
- $document.meta.data<TestML> = ~$<testml_version>;
-}
+ method meta_testml_statement($/) {
+ $document.meta.data<TestML> = ~$<testml_version>;
+ }
-method meta_statement($/) {
- $document.meta.data{~$<meta_keyword>} = $<meta_value>.ast;
-}
+ method meta_statement($/) {
+ $document.meta.data{~$<meta_keyword>} = $<meta_value>.ast;
+ }
-method meta_value($/) {
- make $<quoted_string>
- ?? $<quoted_string>.ast
- !! $<unquoted_string>.ast;
-}
+ method meta_value($/) {
+ make $<quoted_string>
+ ?? $<quoted_string>.ast
+ !! $<unquoted_string>.ast;
+ }
-### Test Section ###
-method try_test_statement($/) {
- $statement = TestML::Statement.new;
- @expression_stack.push($statement.expression);
-}
+ ### Test Section ###
+ method try_test_statement($/) {
+ $statement = TestML::Statement.new;
+ @expression_stack.push($statement.expression);
+ }
-method test_statement($/) {
- $document.test.statements.push($statement);
- @expression_stack.pop();
-}
+ method test_statement($/) {
+ $document.test.statements.push($statement);
+ @expression_stack.pop();
+ }
-method point_call($/) {
- my $point_name = ~$0;
- my $transform = TestML::Transform.new(name => 'Point', args => [$point_name]);
- @expression_stack[*-1].transforms.push($transform);
- $statement.points.push($point_name);
-}
+ method point_call($/) {
+ my $point_name = ~$0;
+ my $transform = TestML::Transform.new(name => 'Point', args => [$point_name]);
+ @expression_stack[*-1].transforms.push($transform);
+ $statement.points.push($point_name);
+ }
-method transform_call($/) {
- @expression_stack.pop();
- my $transform_name = ~$<transform_name>;
- my $transform = TestML::Transform.new(
- name => $transform_name,
- args => $transform_arguments,
- );
- @expression_stack[*-1].transforms.push($transform);
-}
+ method transform_call($/) {
+ @expression_stack.pop();
+ my $transform_name = ~$<transform_name>;
+ my $transform = TestML::Transform.new(
+ name => $transform_name,
+ args => $transform_arguments,
+ );
+ @expression_stack[*-1].transforms.push($transform);
+ }
-method transform_name($/) {
- @expression_stack.push(TestML::Expression.new);
- $transform_arguments = [];
-}
+ method transform_name($/) {
+ @expression_stack.push(TestML::Expression.new);
+ $transform_arguments = [];
+ }
-method transform_argument($/) {
- $transform_arguments.push(@expression_stack.pop());
- @expression_stack.push(TestML::Expression.new);
-}
+ method transform_argument($/) {
+ $transform_arguments.push(@expression_stack.pop());
+ @expression_stack.push(TestML::Expression.new);
+ }
-method string_call($/) {
- my $string = $<quoted_string>.ast;
- my $transform = TestML::String.new(
- value => $string,
- );
- @expression_stack[*-1].transforms.push($transform);
-}
+ method string_call($/) {
+ my $string = $<quoted_string>.ast;
+ my $transform = TestML::String.new(
+ value => $string,
+ );
+ @expression_stack[*-1].transforms.push($transform);
+ }
-method try_assertion_call($/) {
- $statement.assertion = TestML::Assertion.new;
- @expression_stack.push($statement.assertion.expression);
-}
+ method try_assertion_call($/) {
+ $statement.assertion = TestML::Assertion.new;
+ @expression_stack.push($statement.assertion.expression);
+ }
-method assertion_call($/) {
- @expression_stack.pop();
-}
+ method assertion_call($/) {
+ @expression_stack.pop();
+ }
-method not_assertion_call($/) {
- $statement.assertion = Nil;
- @expression_stack.pop();
-}
+ method not_assertion_call($/) {
+ $statement.assertion = Nil;
+ @expression_stack.pop();
+ }
-method assertion_eq($/) {
- $statement.assertion.name = 'EQ';
-}
+ method assertion_eq($/) {
+ $statement.assertion.name = 'EQ';
+ }
-method assertion_ok($/) {
- $statement.assertion.name = 'OK';
-}
+ method assertion_ok($/) {
+ $statement.assertion.name = 'OK';
+ }
-method assertion_has($/) {
- $statement.assertion.name = 'HAS';
-}
+ method assertion_has($/) {
+ $statement.assertion.name = 'HAS';
+ }
-### Data Section ###
-method data_section($/) {
- $data = ~$/;
-}
+ ### Data Section ###
+ method data_section($/) {
+ $data = ~$/;
+ }
-method data_block($/) {
- my $block = TestML::Block.new;
- $block.label = ~$<block_header><block_label>;
- for $<block_point> -> $point {
- my ($name, $value);
- if $point<phrase_point> {
- $name = ~$point<phrase_point><point_name>;
- $value = ~$point<phrase_point>[0];
- }
- else {
- $name = ~$point<lines_point><point_name>;
- $value = ~$point<lines_point>[0];
+ method data_block($/) {
+ my $block = TestML::Block.new;
+ $block.label = ~$<block_header><block_label>;
+ for $<block_point> -> $point {
+ my ($name, $value);
+ if $point<phrase_point> {
+ $name = ~$point<phrase_point><point_name>;
+ $value = ~$point<phrase_point>[0];
+ }
+ else {
+ $name = ~$point<lines_point><point_name>;
+ $value = ~$point<lines_point>[0];
+ }
+ $block.points{$name} = $value;
}
- $block.points{$name} = $value;
+ $document.data.blocks.push($block);
}
- $document.data.blocks.push($block);
}
View
2  lib/TestML/Parser/Grammar.pm
@@ -312,3 +312,5 @@ token user_point_name {
<LOWER> <WORD>*
}
+
+method panic($err) { die $err }
View
373 lib/TestML/Runner.pm
@@ -4,217 +4,220 @@ class TestML::Context { ... }
use TestML::Parser;
-class TestML::Runner;
-
-has $.bridge;
-has $.document;
-has $.base = $*PROGRAM_NAME.flip.subst(/.*?'/'/, '').flip; #'RAKUDO
-has $.doc = $.parse_document();
-has $.transform_modules = $._transform_modules;
-
-method title() { ... }
-method plan_begin() { ... }
-method plan_end() { ... }
-
-method run() {
- $.title();
- $.plan_begin();
-
- for $.doc.test.statements -> $statement {
- my @blocks = $statement.points.elems
- ?? $.select_blocks($statement.points)
- !! TestML::Block.new; !1;
- for @blocks -> $block {
- my $left = $.evaluate_expression(
- $statement.expression,
- $block,
- );
- if $statement.assertion -> $assertion {
- my $method = 'assert_' ~ $assertion.name;
- if $assertion.expression.transforms.elems {
- my $right = $.evaluate_expression(
- $statement.assertion.expression,
- $block,
- );
- self."$method"($left, $right, $block.label);
- }
- else {
- self."$method"($left, $block.label);
+class TestML::Runner {
+
+ has $.bridge;
+ has $.document;
+ has $.base = $*PROGRAM_NAME.flip.subst(/.*?'/'/, '').flip; #'RAKUDO
+ has $.doc = self.parse_document();
+ has $.transform_modules = self._transform_modules;
+
+ method title() { ... }
+ method plan_begin() { ... }
+ method plan_end() { ... }
+
+ method run() {
+ $.title();
+ $.plan_begin();
+
+ for $.doc.test.statements -> $statement {
+ my @blocks = $statement.points.elems
+ ?? $.select_blocks($statement.points)
+ !! TestML::Block.new; !1;
+ for @blocks -> $block {
+ my $left = $.evaluate_expression(
+ $statement.expression,
+ $block,
+ );
+ if $statement.assertion -> $assertion {
+ my $method = 'assert_' ~ $assertion.name;
+ if $assertion.expression.transforms.elems {
+ my $right = $.evaluate_expression(
+ $statement.assertion.expression,
+ $block,
+ );
+ self."$method"($left, $right, $block.label);
+ }
+ else {
+ self."$method"($left, $block.label);
+ }
}
}
}
+ $.plan_end();
}
- $.plan_end();
-}
-method select_blocks($points) {
- my @selected;
+ method select_blocks($points) {
+ my @selected;
- for @($.doc.data.blocks) -> $block {
- my %points = $block.points;
- next if %points.exists('SKIP');
- my $next = 0;
- for @($points) -> $point {
- $next = 1 unless %points.exists($point);
- }
- next if $next;
- if %points.exists('ONLY') {
- @selected = ($block);
- last;
+ for @($.doc.data.blocks) -> $block {
+ my %points = $block.points;
+ next if %points.exists('SKIP');
+ my $next = 0;
+ for @($points) -> $point {
+ $next = 1 unless %points.exists($point);
+ }
+ next if $next;
+ if %points.exists('ONLY') {
+ @selected = ($block);
+ last;
+ }
+ @selected.push($block);
+ last if %points.exists('LAST');
}
- @selected.push($block);
- last if %points.exists('LAST');
+ return @selected;
}
- return @selected;
-}
-method evaluate_expression($expression, $block) {
- my $context = TestML::Context.new(
- :document($.doc),
- :block($block),
- :not(0),
- :type('None'),
- );
-
- for $expression.transforms -> $transform {
- my $transform_name = $transform.name;
- my $what = $transform.WHAT;
- if ("$what" eq 'TestML::String()') {
- $context.set('Str', $transform.value);
- next;
- }
- if $transform_name eq 'Not' {
- $context.not = not $context.not;
- next;
- }
- next if $context.error and $transform_name ne 'Catch';
- my $function = $.get_transform_function($transform_name);
- $context._set = 0;
- my $value;
- try {
- $value = $function(
- $context,
- | $transform.args.map({
- $_ ~~ TestML::Expression
- ?? $.evaluate_expression($_, $block)
- !! $_
- })
- );
-
- CATCH {
- $context.type = 'Error';
- $context.error = "$!";
- $context.value = Nil;
+ method evaluate_expression($expression, $block) {
+ my $context = TestML::Context.new(
+ :document($.doc),
+ :block($block),
+ :not(0),
+ :type('None'),
+ );
+
+ for $expression.transforms -> $transform {
+ my $transform_name = $transform.name;
+ my $what = $transform.WHAT;
+ if ("$what" eq 'TestML::String()') {
+ $context.set('Str', $transform.value);
+ next;
+ }
+ if $transform_name eq 'Not' {
+ $context.not = not $context.not;
+ next;
+ }
+ next if $context.error and $transform_name ne 'Catch';
+ my $function = $.get_transform_function($transform_name);
+ $context._set = 0;
+ my $value;
+ try {
+ $value = $function(
+ $context,
+ | $transform.args.map({
+ $_ ~~ TestML::Expression
+ ?? $.evaluate_expression($_, $block)
+ !! $_
+ })
+ );
+
+ CATCH {
+ default {
+ $context.type = 'Error';
+ $context.error = "$!";
+ $context.value = Nil;
+ }
+ }
+ }
+ if not $context._set {
+ $context.value = $value;
}
}
- if not $context._set {
- $context.value = $value;
+
+ if $context.error {
+ die $context.error;
}
+
+ return $context;
}
- if $context.error {
- die $context.error;
+ method get_transform_function($name) {
+ my @modules = $.transform_modules;
+ for @modules -> $module_name {
+ my $function = eval "&$module_name" ~ "::$name";
+ return $function if $function;
+ }
+ die "Can't locate function '$name'";
}
- return $context;
-}
+ method parse_document() {
+ my $testml = slurp join '/', $.base, $.document;
+ my $document = TestML::Parser.parse($testml)
+ or die "TestML document failed to parse";
+ return $document;
+ }
-method get_transform_function($name) {
- my @modules = $.transform_modules;
- for @modules -> $module_name {
- my $function = eval "&$module_name" ~ "::$name";
- return $function if $function;
+ method _transform_modules() {
+ my @modules = (
+ 'TestML::Standard',
+ );
+ if $.bridge {
+ @modules.push($.bridge);
+ }
+ for @modules -> $module_name {
+ eval "use $module_name";
+ my $module = eval($module_name);
+ die "Can't use $module_name " ~ ~@*INC
+ unless ~$module;
+ }
+ return @modules;
}
- die "Can't locate function '$name'";
-}
-method parse_document() {
- my $testml = slurp join '/', $.base, $.document;
- my $document = TestML::Parser.parse($testml)
- or die "TestML document failed to parse";
- return $document;
}
-method _transform_modules() {
- my @modules = (
- 'TestML::Standard',
- );
- if $.bridge {
- @modules.push($.bridge);
- }
- for @modules -> $module_name {
- eval "use $module_name";
- my $module = eval($module_name);
- die "Can't use $module_name " ~ ~@*INC
- unless ~$module;
+class TestML::Context {
+
+ has $.document is rw;
+ has $.block is rw;
+ has $.point is rw;
+ has $.value is rw;
+ has $.error is rw;
+ has $.type is rw;
+ has $.not is rw;
+ has $._set is rw;
+
+ method set($type, $value) {
+ $.throw("Invalid context type '$type'")
+ unless $type ~~ /^[None|Str|Num|Bool|List]$/;
+ $.type = $type;
+ $.value = $value;
+ $._set = 1;
}
- return @modules;
-}
-
-
-class TestML::Context;
-
-has $.document is rw;
-has $.block is rw;
-has $.point is rw;
-has $.value is rw;
-has $.error is rw;
-has $.type is rw;
-has $.not is rw;
-has $._set is rw;
-
-method set($type, $value) {
- $.throw("Invalid context type '$type'")
- unless $type ~~ /^[None|Str|Num|Bool|List]$/;
- $.type = $type;
- $.value = $value;
- $._set = 1;
-}
# TODO
-method get_value_if_type(*@types) {
- my $type = $.type;
- return $.value if @types.grep($type).Bool;
- $.throw("context object is type '$type', but '@types' required");
-}
+ method get_value_if_type(*@types) {
+ my $type = $.type;
+ return $.value if @types.grep($type).Bool;
+ $.throw("context object is type '$type', but '@types' required");
+ }
-method get_value_as_str() {
- my $type = $.type;
- my $value = $.value;
- return
- $type eq 'Str' ?? $value !!
- $type eq 'List' ?? $value.join("") !!
- $type eq 'Bool' ?? $value ?? '1' !! '' !!
- $type eq 'Num' ?? "$value" !!
- $type eq 'None' ?? '' !!
- $.throw("Str type error: '$type'");
-}
+ method get_value_as_str() {
+ my $type = $.type;
+ my $value = $.value;
+ return
+ $type eq 'Str' ?? $value !!
+ $type eq 'List' ?? $value.join("") !!
+ $type eq 'Bool' ?? $value ?? '1' !! '' !!
+ $type eq 'Num' ?? "$value" !!
+ $type eq 'None' ?? '' !!
+ $.throw("Str type error: '$type'");
+ }
-method get_value_as_num() {
- my $type = $.type;
- my $value = $.value;
- return
- $type eq 'Str' ?? $value + 0 !!
- $type eq 'List' ?? $value.elems !!
- $type eq 'Bool' ?? $value ?? 1 !! 0 !!
- $type eq 'Num' ?? $value !!
- $type eq 'None' ?? 0 !!
- $.throw("Num type error: '$type'");
-}
+ method get_value_as_num() {
+ my $type = $.type;
+ my $value = $.value;
+ return
+ $type eq 'Str' ?? $value + 0 !!
+ $type eq 'List' ?? $value.elems !!
+ $type eq 'Bool' ?? $value ?? 1 !! 0 !!
+ $type eq 'Num' ?? $value !!
+ $type eq 'None' ?? 0 !!
+ $.throw("Num type error: '$type'");
+ }
-method get_value_as_bool() {
- my $type = $.type;
- my $value = $.value;
- return
- $type eq 'Str' ?? $value.chars.Bool !!
- $type eq 'List' ?? $value.elems.Bool !!
- $type eq 'Bool' ?? $value !!
- $type eq 'Num' ?? $value.Bool !!
- $type eq 'None' ?? Bool::False !!
- $.throw("Bool type error: '$type'");
-}
+ method get_value_as_bool() {
+ my $type = $.type;
+ my $value = $.value;
+ return
+ $type eq 'Str' ?? $value.chars.Bool !!
+ $type eq 'List' ?? $value.elems.Bool !!
+ $type eq 'Bool' ?? $value !!
+ $type eq 'Num' ?? $value.Bool !!
+ $type eq 'None' ?? Bool::False !!
+ $.throw("Bool type error: '$type'");
+ }
-method throw($msg) {
- die $msg;
+ method throw($msg) {
+ die $msg;
+ }
}
-
Something went wrong with that request. Please try again.