actually, throw an exception on parse errors

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;