From 4199ad8758797606d465bc7d9cef1942adbd3e2d Mon Sep 17 00:00:00 2001
From: Dan Hirsch <thequux@upstandinghackers.com>
Date: Wed, 4 Dec 2013 04:44:07 +0100
Subject: [PATCH] All tests except attr_bool pass
---
src/bindings/perl/hammer.i | 38 +++++--
src/bindings/perl/t/hammer.t | 200 ++++++++++++++++++++++++++++++++++-
2 files changed, 229 insertions(+), 9 deletions(-)
diff --git a/src/bindings/perl/hammer.i b/src/bindings/perl/hammer.i
index 4903657..68f73dd 100644
--- a/src/bindings/perl/hammer.i
+++ b/src/bindings/perl/hammer.i
@@ -38,7 +38,7 @@
AV* av = (AV*) SvRV($input);
size_t amax = av_top_index(av) + 1; // I want the length, not the top index...
// TODO: is this array copied?
- $1 = malloc(amax * sizeof(*$1));
+ $1 = malloc((amax+1) * sizeof(*$1));
$1[amax] = NULL;
for (int i = 0; i < amax; i++) {
int res = SWIG_ConvertPtr(*av_fetch(av, i, 0), &($1[i]), SWIGTYPE_p_HParser_, 0|0);
@@ -72,12 +72,33 @@
%rename("token") h_token;
%rename("%(regex:/^h_(.*)/\\1/)s", regextarget=1) "^h_u?int(64|32|16|8)";
-%rename("end_p") h_end_p;
-%rename("left") h_left;
-%rename("middle") h_middle;
-%rename("right") h_right;
-%rename("int_range") h_int_range;
-%rename("whitespace") h_whitespace;
+
+%define %combinator %rename("%(regex:/^h_(.*)$/\\1/)s") %enddef
+
+%combinator h_end_p;
+%combinator h_left;
+%combinator h_middle;
+%combinator h_right;
+%combinator h_int_range;
+%combinator h_whitespace;
+%combinator h_nothing_p;
+
+%combinator h_butnot;
+%combinator h_difference;
+%combinator h_xor;
+%combinator h_many;
+%combinator h_many1;
+%combinator h_sepBy;
+%combinator h_sepBy1;
+%combinator h_repeat_n;
+%combinator h_ignore;
+%combinator h_optional;
+%combinator h_epsilon_p;
+%combinator h_and;
+%combinator h_not;
+%combinator h_indirect;
+%combinator h_bind_indirect;
+
%include "../swig/hammer.i";
@@ -86,7 +107,7 @@
// All values that this function returns have a refcount of exactly 1.
SV *ret;
if (token == NULL) {
- return newSV(0); // TODO: croak.
+ return newSV(0); // Same as TT_NONE
}
switch (token->token_type) {
case TT_NONE:
@@ -230,4 +251,5 @@
return h__not_in(join('',@_));
}
+
%}
diff --git a/src/bindings/perl/t/hammer.t b/src/bindings/perl/t/hammer.t
index 424aa9c..2c7f744 100644
--- a/src/bindings/perl/t/hammer.t
+++ b/src/bindings/perl/t/hammer.t
@@ -1,9 +1,17 @@
# -*- cperl -*-
use warnings;
use strict;
-use Test::More tests => 21;
+use Data::Dumper;
+use Test::More tests => 41;
use hammer;
+# differences from C version:
+
+# - in takes any number of arguments, which are concatenated. This
+# makes ch_range irrelevant.
+#
+# - foo
+
sub check_parse_eq {
my ($parser, $input, $expected) = @_;
@@ -15,6 +23,7 @@ sub check_parse_eq {
diag($@);
ok($@ eq "");
} else {
+ #diag(Dumper($actual));
is_deeply($actual, $expected);
}
}
@@ -189,3 +198,192 @@ subtest "end_p" => sub {
check_parse_eq($parser, 'a', ['a']);
check_parse_failed($parser, 'aa');
};
+
+subtest "nothing_p" => sub {
+ my $parser = hammer::nothing_p();
+ check_parse_failed($parser, "");
+ check_parse_failed($parser, "foo");
+};
+
+subtest "sequence" => sub {
+ my $parser = hammer::sequence(hammer::ch('a'), hammer::ch('b'));
+ check_parse_eq($parser, "ab", ['a','b']);
+ check_parse_failed($parser, 'a');
+ check_parse_failed($parser, 'b');
+};
+
+subtest "sequence-whitespace" => sub {
+ my $parser = hammer::sequence(hammer::ch('a'),
+ hammer::whitespace(hammer::ch('b')));
+ check_parse_eq($parser, "ab", ['a', 'b']);
+ check_parse_eq($parser, "a b", ['a', 'b']);
+ check_parse_eq($parser, "a b", ['a', 'b']);
+ check_parse_failed($parser, "a c");
+};
+
+subtest "choice" => sub { # test 25
+ my $parser = hammer::choice(hammer::ch('a'),
+ hammer::ch('b'));
+ check_parse_eq($parser, 'a', 'a');
+ check_parse_eq($parser, 'b', 'b');
+ check_parse_failed($parser, 'c');
+};
+
+subtest "butnot" => sub {
+ my $parser = hammer::butnot(hammer::ch('a'), hammer::token('ab'));
+ check_parse_eq($parser, 'a', 'a');
+ check_parse_eq($parser, 'aa', 'a');
+ check_parse_failed($parser, 'ab');
+};
+
+subtest "butnot-range" => sub {
+ my $parser = hammer::butnot(hammer::ch_range('0', '9'), hammer::ch('6'));
+ check_parse_eq($parser, '4', '4');
+ check_parse_failed($parser, '6');
+};
+
+subtest "difference" => sub {
+ my $parser = hammer::difference(hammer::token('ab'),
+ hammer::ch('a'));
+ check_parse_eq($parser, 'ab', 'ab');
+ check_parse_failed($parser, 'a');
+};
+
+subtest "xor" => sub {
+ my $parser = hammer::xor(hammer::in('0'..'6'),
+ hammer::in('5'..'9'));
+ check_parse_eq($parser, '0', '0');
+ check_parse_eq($parser, '9', '9');
+ check_parse_failed($parser, '5');
+ check_parse_failed($parser, 'a');
+};
+
+subtest "many" => sub { # test 30
+ my $parser = hammer::many(hammer::in('ab'));
+ check_parse_eq($parser, '', []);
+ check_parse_eq($parser, 'a', ['a']);
+ check_parse_eq($parser, 'b', ['b']);
+ check_parse_eq($parser, 'aabbaba', [qw/a a b b a b a/]);
+};
+
+subtest "many1" => sub {
+ my $parser = hammer::many1(hammer::in('ab'));
+ check_parse_eq($parser, 'a', ['a']);
+ check_parse_eq($parser, 'b', ['b']);
+ check_parse_eq($parser, 'aabbaba', [qw/a a b b a b a/]);
+ check_parse_failed($parser, '');
+ check_parse_failed($parser, 'daabbabadef');
+};
+subtest "repeat_n" => sub {
+ my $parser = hammer::repeat_n(hammer::in('ab'), 2);
+ check_parse_eq($parser, 'abdef', ['a','b']);
+ check_parse_failed($parser, 'adef');
+};
+
+subtest "optional" => sub {
+ my $parser = hammer::sequence(hammer::ch('a'),
+ hammer::optional(hammer::in('bc')),
+ hammer::ch('d'));
+ check_parse_eq($parser, 'abd', [qw/a b d/]);
+ check_parse_eq($parser, 'abd', [qw/a b d/]);
+ check_parse_eq($parser, 'ad', ['a',undef,'d']);
+ check_parse_failed($parser, 'aed');
+ check_parse_failed($parser, 'ab');
+ check_parse_failed($parser, 'ac');
+};
+
+subtest "ignore" => sub {
+ my $parser = hammer::sequence(hammer::ch('a'),
+ hammer::ignore(hammer::ch('b')),
+ hammer::ch('c'));
+ check_parse_eq($parser, "abc", ['a','c']);
+ check_parse_failed($parser, 'ac');
+};
+
+subtest "sepBy" => sub { # Test 35
+ my $parser = hammer::sepBy(hammer::in('1'..'3'),
+ hammer::ch(','));
+ check_parse_eq($parser, '1,2,3', ['1','2','3']);
+ check_parse_eq($parser, '1,3,2', ['1','3','2']);
+ check_parse_eq($parser, '1,3', ['1','3']);
+ check_parse_eq($parser, '3', ['3']);
+ check_parse_eq($parser, '', []);
+};
+
+subtest "sepBy1" => sub {
+ my $parser = hammer::sepBy1(hammer::in("123"),
+ hammer::ch(','));
+ check_parse_eq($parser, '1,2,3', ['1','2','3']);
+ check_parse_eq($parser, '1,3,2', ['1','3','2']);
+ check_parse_eq($parser, '1,3', ['1','3']);
+ check_parse_eq($parser, '3', ['3']);
+ check_parse_failed($parser, '');
+};
+
+subtest "epsilon" => sub {
+ check_parse_eq(hammer::sequence(hammer::ch('a'),
+ hammer::epsilon_p(),
+ hammer::ch('b')),
+ 'ab', ['a','b']);
+ check_parse_eq(hammer::sequence(hammer::epsilon_p(),
+ hammer::ch('a')),
+ 'a', ['a']);
+ check_parse_eq(hammer::sequence(hammer::ch('a'),
+ hammer::epsilon_p()),
+ 'a', ['a']);
+};
+
+
+TODO: {
+ local $TODO = "not implemented";
+ subtest "attr_bool" => sub {
+ fail;
+ }
+};
+
+subtest "and" => sub {
+ check_parse_eq(hammer::sequence(hammer::and(hammer::ch('0')),
+ hammer::ch('0')),
+ '0', ['0']);
+ check_parse_failed(hammer::sequence(hammer::and(hammer::ch('0')),
+ hammer::ch('1')),
+ '0');
+ my $parser = hammer::sequence(hammer::ch('1'),
+ hammer::and(hammer::ch('2')));
+ check_parse_eq($parser, '12', ['1']);
+ check_parse_failed($parser, '1');
+ check_parse_failed($parser, '13');
+};
+
+subtest "not" => sub { # test 40
+ # This is not how you'd *actually* write the parser for this
+ # language; in case of Packrat, it's better to swap the order of the
+ # arguments, and for other backends, the problem doesn't appear at
+ # all.
+ my $parser = hammer::sequence(hammer::ch('a'),
+ hammer::choice(hammer::ch('+'),
+ hammer::token('++')),
+ hammer::ch('b'));
+ check_parse_eq($parser, 'a+b', ['a','+','b']);
+ check_parse_failed($parser, 'a++b'); # ordered choice
+
+ $parser = hammer::sequence(hammer::ch('a'),
+ hammer::choice(hammer::sequence(hammer::ch('+'),
+ hammer::not(hammer::ch('+'))),
+ hammer::token('++')),
+ hammer::ch('b'));
+ check_parse_eq($parser, 'a+b', ['a',['+'],'b']);
+ check_parse_eq($parser, 'a++b', ['a', '++', 'b']);
+};
+
+subtest "rightrec" => sub {
+ my $parser = hammer::indirect();
+ hammer::bind_indirect($parser,
+ hammer::choice(hammer::sequence(hammer::ch('a'),
+ $parser),
+ hammer::epsilon_p));
+ check_parse_eq($parser, 'a', ['a']);
+ check_parse_eq($parser, 'aa', ['a', ['a']]);
+ check_parse_eq($parser, 'aaa', ['a', ['a', ['a']]]);
+};
+
--
GitLab