summaryrefslogtreecommitdiffstats
path: root/t
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-07-23 13:58:23 -0400
committerJesse Luehrs <doy@tozt.net>2013-07-23 13:58:23 -0400
commitbff8a47c7872d34f41a22573dcf9cea0497c8ecc (patch)
tree868decc401a268a8c3bdd6cfa565ee391ee7b436 /t
parent310ba62c846379ad914942e36b9111084a364899 (diff)
downloadparse-keyword-bff8a47c7872d34f41a22573dcf9cea0497c8ecc.tar.gz
parse-keyword-bff8a47c7872d34f41a22573dcf9cea0497c8ecc.zip
actually, don't throw an error
Diffstat (limited to 't')
-rw-r--r--t/error.pl9
-rw-r--r--t/error.t109
-rw-r--r--t/lib/My/Parser.pm28
3 files changed, 98 insertions, 48 deletions
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;