summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-08-18 19:01:22 -0500
committerJesse Luehrs <doy@tozt.net>2012-08-18 19:01:22 -0500
commit1e22f62b2c6bb17153f0524ea3a1b684346a8988 (patch)
treecd0f1f85b7e737df5eea19eebee67bc01584b2c4
parent6d034593a5f0b02eb9e5b7069fa86814aae07b7c (diff)
downloadfun-1e22f62b2c6bb17153f0524ea3a1b684346a8988.tar.gz
fun-1e22f62b2c6bb17153f0524ea3a1b684346a8988.zip
support anonymous functions
-rw-r--r--Fun.xs22
-rw-r--r--lib/Fun.pm12
-rw-r--r--t/anon.t12
3 files changed, 35 insertions, 11 deletions
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;