From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 21 Oct 2010 04:59:01 +0000 (-0500)
Subject: start refactoring to potentially allow for memoization
X-Git-Tag: 0.01~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3c276587bcc908113045cda767c9d40bdf497d4;p=gitmo%2FEval-Closure.git

start refactoring to potentially allow for memoization
---

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";
 }