summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-08-18 19:24:59 -0500
committerJesse Luehrs <doy@tozt.net>2012-08-18 19:24:59 -0500
commit3ce18c876e750d53fa5df8d283e3f4ff8d2dfa94 (patch)
treeb3254c19d99fac4e7165493749246271daefc3eb
parent1e22f62b2c6bb17153f0524ea3a1b684346a8988 (diff)
downloadfun-3ce18c876e750d53fa5df8d283e3f4ff8d2dfa94.tar.gz
fun-3ce18c876e750d53fa5df8d283e3f4ff8d2dfa94.zip
make fun work at compile time
-rw-r--r--Fun.xs33
-rw-r--r--lib/Fun.pm16
-rw-r--r--t/compile-time.t2
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" }