From 1e22f62b2c6bb17153f0524ea3a1b684346a8988 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 18 Aug 2012 19:01:22 -0500
Subject: support anonymous functions

---
 Fun.xs     | 22 ++++++++++++++--------
 lib/Fun.pm | 12 +++++++++---
 t/anon.t   | 12 ++++++++++++
 3 files changed, 35 insertions(+), 11 deletions(-)
 create mode 100644 t/anon.t

diff --git a/Fun.xs b/Fun.xs
index 50e802b..561bbfa 100644
--- a/Fun.xs
+++ b/Fun.xs
@@ -183,14 +183,14 @@ static OP *parse_fun(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
 {
     I32 floor;
     SV *function_name = NULL;
-    OP *arg_assign = NULL, *block, *code;
-
-    *flagsp |= CALLPARSER_STATEMENT;
+    OP *arg_assign = NULL, *block, *code, *name;
 
     floor = start_subparse(0, CVf_ANON);
 
     lex_read_space(0);
-    function_name = parse_idword("");
+    if (isIDFIRST(*(PL_parser->bufptr))) {
+        function_name = parse_idword("");
+    }
 
     lex_read_space(0);
     if (lex_peek_unichar(0) == '(') {
@@ -209,10 +209,16 @@ static OP *parse_fun(pTHX_ GV *namegv, SV *psobj, U32 *flagsp)
 
     code = newANONSUB(floor, NULL, block);
 
-    SvREFCNT_inc(function_name);
-    return newLISTOP(OP_LIST, 0,
-                     newSVOP(OP_CONST, 0, function_name),
-                     code);
+    if (function_name) {
+        SvREFCNT_inc(function_name);
+        name = newSVOP(OP_CONST, 0, function_name);
+        *flagsp |= CALLPARSER_STATEMENT;
+    }
+    else {
+        name = newOP(OP_UNDEF, 0);
+    }
+
+    return newLISTOP(OP_LIST, 0, name, code);
 }
 
 
diff --git a/lib/Fun.pm b/lib/Fun.pm
index 188adfb..b4f1f7e 100644
--- a/lib/Fun.pm
+++ b/lib/Fun.pm
@@ -28,9 +28,15 @@ our @EXPORT = our @EXPORT_OK = ('fun');
 
 sub fun {
     my ($name, $code) = @_;
-    my $caller = caller;
-    no strict 'refs';
-    *{ $caller . '::' . $name } = $code;
+
+    if (defined $name) {
+        my $caller = caller;
+        no strict 'refs';
+        *{ $caller . '::' . $name } = $code;
+    }
+    else {
+        return $code;
+    }
 }
 
 =head1 BUGS
diff --git a/t/anon.t b/t/anon.t
new file mode 100644
index 0000000..844fb97
--- /dev/null
+++ b/t/anon.t
@@ -0,0 +1,12 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Fun;
+
+my $fun = fun ($x, $y) { $x * $y };
+
+is($fun->(3, 4), 12);
+
+done_testing;
-- 
cgit v1.2.3