From 3ce18c876e750d53fa5df8d283e3f4ff8d2dfa94 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 18 Aug 2012 19:24:59 -0500
Subject: make fun work at compile time

---
 Fun.xs           | 33 ++++++++++++++++++++++++++-------
 lib/Fun.pm       | 16 ++++++++--------
 t/compile-time.t |  2 --
 3 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/Fun.xs b/Fun.xs
index 561bbfa..a7b1d45 100644
--- a/Fun.xs
+++ b/Fun.xs
@@ -183,7 +183,8 @@ static OP *parse_fun(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
 {
     I32 floor;
     SV *function_name = NULL;
-    OP *arg_assign = NULL, *block, *code, *name;
+    CV *code;
+    OP *arg_assign = NULL, *block, *name;
 
     floor = start_subparse(0, CVf_ANON);
 
@@ -207,18 +208,36 @@ static OP *parse_fun(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
 	                        block);
     }
 
-    code = newANONSUB(floor, NULL, block);
-
     if (function_name) {
+        SV *code;
+
+        *flagsp |= CALLPARSER_STATEMENT;
         SvREFCNT_inc(function_name);
         name = newSVOP(OP_CONST, 0, function_name);
-        *flagsp |= CALLPARSER_STATEMENT;
+        code = newRV_inc((SV*)newATTRSUB(floor, name, NULL, NULL, block));
+
+        ENTER;
+        {
+            dSP;
+            PUSHMARK(SP);
+            EXTEND(SP, 2);
+            PUSHs(function_name);
+            PUSHs(code);
+            PUTBACK;
+            call_pv("Fun::_install_fun", G_VOID);
+            PUTBACK;
+        }
+        LEAVE;
+
+        return newOP(OP_NULL, 0);
     }
     else {
-        name = newOP(OP_UNDEF, 0);
-    }
+        OP *code;
 
-    return newLISTOP(OP_LIST, 0, name, code);
+        code = newANONSUB(floor, NULL, block);
+
+        return newLISTOP(OP_LIST, 0, code, NULL);
+    }
 }
 
 
diff --git a/lib/Fun.pm b/lib/Fun.pm
index b4f1f7e..c18b6bf 100644
--- a/lib/Fun.pm
+++ b/lib/Fun.pm
@@ -27,16 +27,16 @@ our @EXPORT = our @EXPORT_OK = ('fun');
 =cut
 
 sub fun {
+    my ($code) = @_;
+    return $code;
+}
+
+sub _install_fun {
     my ($name, $code) = @_;
 
-    if (defined $name) {
-        my $caller = caller;
-        no strict 'refs';
-        *{ $caller . '::' . $name } = $code;
-    }
-    else {
-        return $code;
-    }
+    my $caller = caller;
+    no strict 'refs';
+    *{ $caller . '::' . $name } = $code;
 }
 
 =head1 BUGS
diff --git a/t/compile-time.t b/t/compile-time.t
index a20ff6c..6dcbc53 100644
--- a/t/compile-time.t
+++ b/t/compile-time.t
@@ -5,9 +5,7 @@ use Test::More;
 
 use Fun;
 
-TODO: { todo_skip "doesn't work at compile time yet", 1;
 is(foo(), "FOO");
-}
 
 fun foo { "FOO" }
 
-- 
cgit v1.2.3