summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorToby Inkster <mail@tobyinkster.co.uk>2013-07-25 09:42:08 +0100
committerJesse Luehrs <doy@tozt.net>2013-07-30 15:44:46 -0400
commitca2be2088b1fbc33d7ed7ba84c224a44add38e89 (patch)
treef19790b17a5bc65c2001e19e987a4978b8e6625a
parent38482e7653fbac3f21de0097b2ded9d1fa0ff64e (diff)
downloadeval-closure-ca2be2088b1fbc33d7ed7ba84c224a44add38e89.tar.gz
eval-closure-ca2be2088b1fbc33d7ed7ba84c224a44add38e89.zip
use Devel::LexAlias when it is available
-rw-r--r--lib/Eval/Closure.pm30
-rw-r--r--t/close-over.t6
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 };