summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-08-02 02:15:22 -0500
committerJesse Luehrs <doy@tozt.net>2011-08-02 02:15:22 -0500
commitabf958af44e43c8df7f5dae4ca291e186cb04a02 (patch)
tree276a13345e9617307a8117ea63c2e734ea14d41b
parent0de2a1d9871b2c7583379c34597057603336fdd2 (diff)
downloadeval-closure-copy_hints.tar.gz
eval-closure-copy_hints.zip
is setting up hints as in the caller a sane thing to do?copy_hints
-rw-r--r--lib/Eval/Closure.pm4
-rw-r--r--t/basic.t2
-rw-r--r--t/lexical-env.t53
3 files changed, 56 insertions, 3 deletions
diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index ccd2bbc..3d022c9 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -192,8 +192,9 @@ sub _clean_eval_closure {
sub _make_compiler {
my $source = _make_compiler_source(@_);
+ my @caller = caller(2); # XXX make sure this stays in sync
- return @{ _clean_eval($source) };
+ return @{ _clean_eval($source, $caller[8]) };
}
$Eval::Closure::SANDBOX_ID = 0;
@@ -204,6 +205,7 @@ sub _clean_eval {
package Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID;
local \$@;
local \$SIG{__DIE__};
+BEGIN { \$^H = $_[1] }
my \$compiler = eval \$_[0];
my \$e = \$@;
[ \$compiler, \$e ];
diff --git a/t/basic.t b/t/basic.t
index 3a318ac..3f2a9a2 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -35,8 +35,6 @@ use Eval::Closure;
my $foo = [1, 2, 3];
my $code = eval_closure(
- # not sure if strict leaking into evals is intended, i think i remember
- # it being changed in newer perls
source => 'do { no strict; sub { $foo } }',
);
diff --git a/t/lexical-env.t b/t/lexical-env.t
new file mode 100644
index 0000000..24d4885
--- /dev/null
+++ b/t/lexical-env.t
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+use Eval::Closure;
+
+{
+ my $source = 'sub { ++$foo }';
+
+ {
+ like(
+ exception {
+ eval_closure(source => $source);
+ },
+ qr/Global symbol "\$foo/,
+ "errors with strict enabled"
+ );
+ }
+
+ {
+ no strict;
+ my $c1;
+ is(
+ exception {
+ $c1 = eval_closure(source => $source);
+ },
+ undef,
+ "no errors with no strict"
+ );
+ is($c1->(), 1);
+ is($c1->(), 2);
+ }
+}
+
+{
+ my $source = 'our $less; BEGIN { $less = $^H{less} } sub { $less }';
+
+ {
+ my $c1 = eval_closure(source => $source);
+ is($c1->(), undef, "nothing in the hint hash");
+ }
+
+ {
+ local $TODO = 'not sure how exactly to get %^H copied';
+ use less "stuff";
+ my $c1 = eval_closure(source => $source);
+ is($c1->(), 'stuff', "use less put stuff in the hints hash");
+ }
+}
+
+done_testing;