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

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

@ -203,6 +203,35 @@
return ret; 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 { %inline {
HParser* ch(uint8_t chr) { HParser* ch(uint8_t chr) {
@ -220,6 +249,9 @@
HParser* action(HParser *parser, SV* sub) { HParser* action(HParser *parser, SV* sub) {
return h_action(parser, call_action, SvREFCNT_inc(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_ { %extend HParser_ {

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

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