diff --git a/src/bindings/perl/hammer.i b/src/bindings/perl/hammer.i index 68f73ddc026e2b6905a1b85a6f29c0dc5f346356..ff9d7f4ebc7cb71c08f0d17872c42159bd41d628 100644 --- a/src/bindings/perl/hammer.i +++ b/src/bindings/perl/hammer.i @@ -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_ { diff --git a/src/bindings/perl/t/hammer.t b/src/bindings/perl/t/hammer.t index 2c7f744bde61b122cce55e587c650d14b507b012..0d402b05f12fc0bc9b3cabbbcd23027572cbb9c6 100644 --- a/src/bindings/perl/t/hammer.t +++ b/src/bindings/perl/t/hammer.t @@ -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 {