From abf958af44e43c8df7f5dae4ca291e186cb04a02 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 2 Aug 2011 02:15:22 -0500
Subject: is setting up hints as in the caller a sane thing to do?

---
 lib/Eval/Closure.pm |  4 +++-
 t/basic.t           |  2 --
 t/lexical-env.t     | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 3 deletions(-)
 create mode 100644 t/lexical-env.t

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;
-- 
cgit v1.2.3