summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-10-20 23:59:01 -0500
committerJesse Luehrs <doy@tozt.net>2010-10-20 23:59:01 -0500
commitf3c276587bcc908113045cda767c9d40bdf497d4 (patch)
tree04d453243ac07613371c4ad28f4e437ce76cfbef
parent409b8f4169b1febda0f36fa7eb66abd79624ada7 (diff)
downloadeval-closure-f3c276587bcc908113045cda767c9d40bdf497d4.tar.gz
eval-closure-f3c276587bcc908113045cda767c9d40bdf497d4.zip
start refactoring to potentially allow for memoization
-rw-r--r--lib/Eval/Closure.pm35
-rw-r--r--t/02-close-over.t14
-rw-r--r--t/03-description.t2
3 files changed, 30 insertions, 21 deletions
diff --git a/lib/Eval/Closure.pm b/lib/Eval/Closure.pm
index 680399a..f90a976 100644
--- a/lib/Eval/Closure.pm
+++ b/lib/Eval/Closure.pm
@@ -75,18 +75,17 @@ sub _line_directive {
}
sub _clean_eval_closure {
- # my ($source, $__captures) = @_
- my $__captures = $_[1];
-
- local $@;
- local $SIG{__DIE__};
+ my ($source, $captures) = @_;
if ($ENV{EVAL_CLOSURE_PRINT_SOURCE}) {
- _dump_source(_make_source(@_));
+ _dump_source(_make_compiler_source(@_));
}
- my $code = eval _make_source(@_);
- my $e = $@;
+ my ($compiler, $e) = _make_compiler(@_);
+ my $code;
+ if (defined $compiler) {
+ $code = $compiler->(map { $captures->{$_} } sort keys %$captures);
+ }
if (defined($code) && (!ref($code) || ref($code) ne 'CODE')) {
$e = "The 'source' parameter must return a subroutine reference, "
@@ -97,14 +96,24 @@ sub _clean_eval_closure {
return ($code, $e);
}
-sub _make_source {
- my ($source, $__captures) = @_;
+sub _make_compiler {
+ local $@;
+ local $SIG{__DIE__};
+ my $compiler = eval _make_compiler_source(@_);
+ my $e = $@;
+ return ($compiler, $e);
+}
+
+sub _make_compiler_source {
+ my ($source, $captures) = @_;
+ my $i = 0;
return join "\n", (
+ 'sub {',
(map {
- 'my ' . $_ . ' = '
- . substr($_, 0, 1) . '{$__captures->{\'' . $_ . '\'}};'
- } keys %$__captures),
+ 'my ' . $_ . ' = ' . substr($_, 0, 1) . '{$_[' . $i++ . ']};'
+ } sort keys %$captures),
$source,
+ '}',
);
}
diff --git a/t/02-close-over.t b/t/02-close-over.t
index ea6792a..4b0e06a 100644
--- a/t/02-close-over.t
+++ b/t/02-close-over.t
@@ -2,6 +2,7 @@
use strict;
use warnings;
use Test::More;
+use Test::Exception;
use Eval::Closure;
@@ -33,16 +34,15 @@ use Test::Requires 'PadWalker';
}
{
- local $TODO = "we still have to close over \$__captures";
my $foo = [];
my $env = { '$foo' => \$foo };
- my $code = eval_closure(
- source => 'sub { push @$foo, @_; return $__captures }',
- environment => $env,
- );
- is_deeply(scalar(PadWalker::closed_over($code)), $env,
- "closed over the right things");
+ throws_ok {
+ my $code = eval_closure(
+ source => 'sub { push @$foo, @_; return $__captures }',
+ environment => $env,
+ );
+ } qr/Global symbol "\$__captures/, "we don't close over \$__captures";
}
# it'd be nice if we could test that closing over other things wasn't possible,
diff --git a/t/03-description.t b/t/03-description.t
index 781ec72..8f7d893 100644
--- a/t/03-description.t
+++ b/t/03-description.t
@@ -19,7 +19,7 @@ SOURCE
throws_ok {
$code->();
- } qr/^foo at \(eval \d+\) line 2\n/,
+ } qr/^foo at \(eval \d+\) line \d+\n/,
"no location info if context isn't passed";
}