emileclarkb/hammer
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Actions work

Browse source
This commit is contained in:
Dan Hirsch 2013-12-04 01:51:59 +01:00
parent 1d11527924
commit 4eebe57908
2 changed files with 161 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

80
src/bindings/perl/t/hammer.t
View file

@ -1,8 +1,10 @@
# -*- cperl -*-
use warnings;
use Test::More tests => 12;
use strict;
use Test::More tests => 21;
use hammer;
sub check_parse_eq {
my ($parser, $input, $expected) = @_;
my $actual;
@ -10,6 +12,7 @@ sub check_parse_eq {
$actual = $parser->parse($input);
};
if ($@) {
diag($@);
ok($@ eq "");
} else {
is_deeply($actual, $expected);
@ -51,6 +54,7 @@ subtest "ch_range" => sub {
SKIP: {
use integer;
no warnings 'portable'; # I know the hex constants are not portable. that's why this test is skipped on <64 bit systems.
skip "Needs 64-bit support", 2 if 0x4000000 * 2 eq -1; # TODO: Not sure if this works; may need $Config{ivsize} >= 8
subtest "int64" => sub {
my $parser = hammer::int64();
@ -110,6 +114,78 @@ subtest "int_range" => sub { # test 12
check_parse_failed($parser, "\x0b");
};
1;
subtest "whitespace" => sub {
my $parser = hammer::whitespace(hammer::ch('a'));
check_parse_eq($parser, "a", "a");
check_parse_eq($parser, " a", "a");
check_parse_eq($parser, " a", "a");
check_parse_eq($parser, "\t\n\ra", "a");
};
subtest "whitespace-end" => sub {
my $parser = hammer::whitespace(hammer::end_p());
check_parse_eq($parser, "", undef);
check_parse_eq($parser, " ", undef);
check_parse_failed($parser, " x", undef)
};
subtest "left" => sub { # test 15
my $parser = hammer::left(hammer::ch('a'),
hammer::ch(' '));
check_parse_eq($parser, "a ", "a");
check_parse_failed($parser, "a");
check_parse_failed($parser, " ");
};
subtest "right" => sub {
my $parser = hammer::right(hammer::ch(' '),
hammer::ch('a'));
check_parse_eq($parser, " a", "a");
check_parse_failed($parser, "a");
check_parse_failed($parser, " ");
};
subtest "middle" => sub {
my $parser = hammer::middle(hammer::ch(' '),
hammer::ch('a'),
hammer::ch(' '));
check_parse_eq($parser, " a ", "a");
for my $test_string (split('/', "a/ / a/a / b /ba / ab")) {
check_parse_failed($parser, $test_string);
}
};
subtest "action" => sub {
my $parser = hammer::action(hammer::sequence(hammer::choice(hammer::ch('a'),
hammer::ch('A')),
hammer::choice(hammer::ch('b'),
hammer::ch('B'))),
sub { [map(uc, @{+shift})]; });
check_parse_eq($parser, "ab", ['A', 'B']);
check_parse_eq($parser, "AB", ['A', 'B']);
check_parse_eq($parser, 'Ab', ['A', 'B']);
check_parse_failed($parser, "XX");
};
subtest "in" => sub {
my $parser = hammer::in('a'..'c');
check_parse_eq($parser, 'a', 'a');
check_parse_eq($parser, 'b', 'b');
check_parse_eq($parser, 'c', 'c');
check_parse_failed($parser, 'd');
};
subtest "not_in" => sub { # test 20
my $parser = hammer::not_in('a'..'c');
check_parse_failed($parser, 'a');
check_parse_failed($parser, 'b');
check_parse_failed($parser, 'c');
check_parse_eq($parser, 'd', 'd');
};
subtest "end_p" => sub {
my $parser = hammer::sequence(hammer::ch('a'), hammer::end_p());
check_parse_eq($parser, 'a', ['a']);
check_parse_failed($parser, 'aa');
};