From ca2be2088b1fbc33d7ed7ba84c224a44add38e89 Mon Sep 17 00:00:00 2001
From: Toby Inkster <mail@tobyinkster.co.uk>
Date: Thu, 25 Jul 2013 09:42:08 +0100
Subject: use Devel::LexAlias when it is available

---
 lib/Eval/Closure.pm | 30 ++++++++++++++++++++++++++----
 t/close-over.t      |  6 ++++--
 2 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index dcfce71..e0f4190 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -11,7 +11,8 @@ use overload ();
 use Scalar::Util qw(reftype);
 use Try::Tiny;
 
-use constant HAS_LEXICAL_SUBS => $] >= 5.018;
+use constant HAS_LEXICAL_SUBS   => $] >= 5.018;
+use constant HAS_DEVEL_LEXALIAS => eval { require Devel::LexAlias };
 
 =head1 SYNOPSIS
 
@@ -199,6 +200,8 @@ sub _clean_eval_closure {
         undef $code;
     }
 
+    _inject_captures($code, $captures);
+
     return ($code, $e);
 }
 
@@ -225,13 +228,13 @@ sub _make_compiler_source {
     return join "\n", (
         "package Eval::Closure::Sandbox_$Eval::Closure::SANDBOX_ID;",
         'sub {',
-            (map { _make_lexical_assignment($_, $i++) } @capture_keys),
+            (map { _make_lexical_stub($_, $i++) } @capture_keys),
             $source,
         '}',
     );
 }
 
-sub _make_lexical_assignment {
+sub _make_lexical_stub {
     my ($key, $index) = @_;
     my $sigil = substr($key, 0, 1);
     my $name = substr($key, 1);
@@ -242,8 +245,27 @@ sub _make_lexical_assignment {
              . 'my ' . $tmpname . ' = $_[' . $index . ']; '
              . 'my sub ' . $name . ' { goto ' . $tmpname . ' }';
     }
+    elsif (HAS_DEVEL_LEXALIAS) {
+        return 'my ' . $key . ';';
+    }
+    else {
+        return 'our ' . $key . ';';
+    }
+}
+
+sub _inject_captures
+{
+    my ($code, $captures) = @_;
+    
+    if (HAS_DEVEL_LEXALIAS) {
+        Devel::LexAlias::lexalias($code, $_, $captures->{$_}) for keys %$captures;
+    }
     else {
-        return 'my ' . $key . ' = ' . $sigil . '{$_[' . $index . ']};';
+        no strict "refs";
+        for (keys %$captures) {
+            my $slot = "Eval::Closure::Sandbox_${Eval::Closure::SANDBOX_ID}::" . substr($_, 1);
+            *{$slot} = $captures->{$_};
+        }
     }
 }
 
diff --git a/t/close-over.t b/t/close-over.t
index 254ec40..6aa0f25 100644
--- a/t/close-over.t
+++ b/t/close-over.t
@@ -9,7 +9,8 @@ use Eval::Closure;
 
 use Test::Requires 'PadWalker';
 
-{
+SKIP: {
+    skip "Devel::LexAlias not available", 1 unless Eval::Closure::HAS_DEVEL_LEXALIAS;
     my $foo = [];
     my $env = { '$foo' => \$foo };
 
@@ -21,7 +22,8 @@ use Test::Requires 'PadWalker';
               "closed over the right things");
 }
 
-{
+SKIP: {
+    skip "Devel::LexAlias not available", 1 unless Eval::Closure::HAS_DEVEL_LEXALIAS;
     my $foo = {};
     my $bar = [];
     my $env = { '$foo' => \$bar, '$bar' => \$foo };
-- 
cgit v1.2.3