From 310ba62c846379ad914942e36b9111084a364899 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 23 Jul 2013 11:46:07 -0400 Subject: actually, throw an exception on parse errors --- Keyword.xs | 9 +++++++-- t/error.t | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 38 insertions(+), 7 deletions(-) diff --git a/Keyword.xs b/Keyword.xs index a68af05..8cfb87a 100644 --- a/Keyword.xs +++ b/Keyword.xs @@ -23,16 +23,21 @@ static SV *parser_fn(OP *(fn)(pTHX_ U32), bool named) { I32 floor; CV *code; + U8 errors; REENTER_PARSER; + SAVEI8(PL_parser->error_count); + PL_parser->error_count = 0; floor = start_subparse(0, named ? 0 : CVf_ANON); code = newATTRSUB(floor, NULL, NULL, NULL, fn(aTHX_ 0)); + errors = PL_parser->error_count; + LEAVE_PARSER; - if (PL_parser->error_count) { - return newSV(0); + if (errors) { + croak_sv(ERRSV); } else { if (CvCLONE(code)) { diff --git a/t/error.t b/t/error.t index 08a478a..4e5b70d 100644 --- a/t/error.t +++ b/t/error.t @@ -7,10 +7,13 @@ my $got_code; BEGIN { package My::Parser; use Exporter 'import'; - our @EXPORT = 'foo'; - use Parse::Keyword { foo => \&parse_foo }; + our @EXPORT = ('foo', 'bar'); + use Parse::Keyword { + foo => \&parse_foo, + bar => \&parse_bar, + }; - sub foo {} + sub foo { 1 } sub parse_foo { lex_read_space; my $code = parse_block; @@ -18,16 +21,39 @@ BEGIN { return sub {}; } + sub bar { 1 } + sub parse_bar { + lex_read_space; + my $code = eval { parse_block }; + $got_code = $code ? 1 : 0; + return sub {}; + } + $INC{'My/Parser.pm'} = __FILE__; } use My::Parser; -eval "foo"; +ok(!eval "foo"); +ok($@); +ok(!$got_code); +ok(eval "foo { }"); +ok(!$@); +ok($got_code); +ok(!eval 'foo { $baz }'); +like($@, qr/^Global symbol "\$baz" requires explicit package name/); + +# even in an eval, unrecoverable errors still throw, because the parser state +# is now too confused to continue - the error will be thrown after normal +# parsing continues +ok(!eval "bar"); ok($@); ok(!$got_code); -eval "foo { }"; +ok(eval "bar { }"); ok(!$@); ok($got_code); +# but recoverable errors no longer throw +ok(eval 'bar { $baz }'); +is($@, ''); done_testing; -- cgit v1.2.3-54-g00ecf