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

All tests pass.

Browse source
This commit is contained in:
Dan Hirsch 2013-12-04 04:56:47 +01:00
parent 4199ad8758
commit 8c44d583e6
2 changed files with 39 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/bindings/perl/hammer.i
View file

@ -202,7 +202,36 @@
return ret;
}
static int call_predicate(HParseResult *p, void* user_data) {
SV *func = (SV*)user_data;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
if (p->ast != NULL) {
mXPUSHs(hpt_to_perl(p->ast));
} else {
mXPUSHs(newSV(0));
}
PUTBACK;
int nret = call_sv(func, G_SCALAR);
SPAGAIN;
if (nret != 1)
croak("Expected 1 return value, got %d", nret);
SV* svret = POPs;
int ret = SvTRUE(svret);
PUTBACK;
FREETMPS;
LEAVE;
return ret;
}
%}
%inline {
HParser* ch(uint8_t chr) {
@ -220,6 +249,9 @@
HParser* action(HParser *parser, SV* sub) {
return h_action(parser, call_action, SvREFCNT_inc(sub));
}
HParser* attr_bool(HParser *parser, SV* sub) {
return h_attr_bool(parser, call_predicate, SvREFCNT_inc(sub));
}
}
%extend HParser_ {

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

@ -334,11 +334,12 @@ subtest "epsilon" => sub {
};
TODO: {
local $TODO = "not implemented";
subtest "attr_bool" => sub {
fail;
}
subtest "attr_bool" => sub {
my $parser = hammer::attr_bool(hammer::many1(hammer::in('ab')),
sub { my ($a, $b) = @{+shift}; $a eq $b });
check_parse_eq($parser, "aa", ['a','a']);
check_parse_eq($parser, "bb", ['b','b']);
check_parse_failed($parser, "ab");
};
subtest "and" => sub {