From bff8a47c7872d34f41a22573dcf9cea0497c8ecc Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 23 Jul 2013 13:58:23 -0400
Subject: actually, don't throw an error

---
 t/error.pl         |   9 +++++
 t/error.t          | 109 ++++++++++++++++++++++++++++++-----------------------
 t/lib/My/Parser.pm |  28 ++++++++++++++
 3 files changed, 98 insertions(+), 48 deletions(-)
 create mode 100644 t/error.pl
 create mode 100644 t/lib/My/Parser.pm

(limited to 't')

diff --git a/t/error.pl b/t/error.pl
new file mode 100644
index 0000000..9f2aeea
--- /dev/null
+++ b/t/error.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use My::Parser;
+
+foo { $baz };
diff --git a/t/error.t b/t/error.t
index 4e5b70d..d8646ff 100644
--- a/t/error.t
+++ b/t/error.t
@@ -2,58 +2,71 @@
 use strict;
 use warnings;
 use Test::More;
+use lib 't/lib';
 
-my $got_code;
-BEGIN {
-    package My::Parser;
-    use Exporter 'import';
-    our @EXPORT = ('foo', 'bar');
-    use Parse::Keyword {
-        foo => \&parse_foo,
-        bar => \&parse_bar,
-    };
-
-    sub foo { 1 }
-    sub parse_foo {
-        lex_read_space;
-        my $code = parse_block;
-        $got_code = $code ? 1 : 0;
-        return sub {};
-    }
-
-    sub bar { 1 }
-    sub parse_bar {
-        lex_read_space;
-        my $code = eval { parse_block };
-        $got_code = $code ? 1 : 0;
-        return sub {};
-    }
+use My::Parser;
 
-    $INC{'My/Parser.pm'} = __FILE__;
+{
+    my $ret = eval 'foo';
+    # not testing the value of $@ because it's just "whatever the parser
+    # happens to do after getting into a confused state"
+    ok($@);
+    ok(!$ret);
+    ok(!$My::Parser::got_code);
+}
+{
+    my $ret = eval 'foo { }';
+    ok(!$@);
+    ok($ret);
+    ok($My::Parser::got_code);
+}
+{
+    my $ret = eval 'foo { $baz }';
+    like($@, qr/^Global symbol "\$baz" requires explicit package name/);
+    ok(!$ret);
+    ok(!$My::Parser::got_code);
 }
 
-use My::Parser;
-
-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/);
+# wrapping a parsing function in an eval doesn't actually help, because parsing
+# doesn't throw errors in the same way. errors are all saved up until parsing
+# finishes, and then they are all reported at once if there were any.
+{
+    my $ret = eval 'bar';
+    # not testing the value of $@ because it's just "whatever the parser
+    # happens to do after getting into a confused state"
+    ok($@);
+    ok(!$ret);
+    ok(!$My::Parser::got_code);
+}
+{
+    my $ret = eval 'bar { }';
+    ok(!$@);
+    ok($ret);
+    ok($My::Parser::got_code);
+}
+{
+    my $ret = eval 'bar { $baz }';
+    # the eval does, however, prevent perl from seeing what the message was
+    like($@, qr/^Compilation error/);
+    ok(!$ret);
+    ok(!$My::Parser::got_code);
+}
 
-# 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);
-ok(eval "bar { }");
-ok(!$@);
-ok($got_code);
-# but recoverable errors no longer throw
-ok(eval 'bar { $baz }');
-is($@, '');
+{
+    skip "Capture::Tiny is required here", 1
+        unless eval { require Capture::Tiny };
+    my ($out, $err, $exit) = Capture::Tiny::capture(sub {
+        system($^X, (map { qq[-I$_] } @INC), 't/error.pl')
+    });
+    is($out, '');
+    is(
+        $err,
+        <<'ERR'
+Global symbol "$baz" requires explicit package name at t/error.pl line 9.
+Execution of t/error.pl aborted due to compilation errors.
+ERR
+    );
+    isnt($exit, 0);
+}
 
 done_testing;
diff --git a/t/lib/My/Parser.pm b/t/lib/My/Parser.pm
new file mode 100644
index 0000000..d8ef95d
--- /dev/null
+++ b/t/lib/My/Parser.pm
@@ -0,0 +1,28 @@
+package My::Parser;
+use Exporter 'import';
+our @EXPORT = ('foo', 'bar');
+
+use Parse::Keyword {
+    foo => \&parse_foo,
+    bar => \&parse_bar,
+};
+
+our $got_code;
+
+sub foo { 1 }
+sub parse_foo {
+    lex_read_space;
+    my $code = parse_block;
+    $got_code = $code ? 1 : 0;
+    return sub {};
+}
+
+sub bar { 1 }
+sub parse_bar {
+    lex_read_space;
+    my $code = eval { parse_block };
+    $got_code = $code ? 1 : 0;
+    return sub {};
+}
+
+1;
-- 
cgit v1.2.3-54-g00ecf