diff options
author | Jesse Luehrs <doy@tozt.net> | 2012-08-18 19:01:22 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2012-08-18 19:01:22 -0500 |
commit | 1e22f62b2c6bb17153f0524ea3a1b684346a8988 (patch) | |
tree | cd0f1f85b7e737df5eea19eebee67bc01584b2c4 | |
parent | 6d034593a5f0b02eb9e5b7069fa86814aae07b7c (diff) | |
download | fun-1e22f62b2c6bb17153f0524ea3a1b684346a8988.tar.gz fun-1e22f62b2c6bb17153f0524ea3a1b684346a8988.zip |
support anonymous functions
-rw-r--r-- | Fun.xs | 22 | ||||
-rw-r--r-- | lib/Fun.pm | 12 | ||||
-rw-r--r-- | t/anon.t | 12 |
3 files changed, 35 insertions, 11 deletions
@@ -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); } @@ -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; |