--- /dev/null
+MANIFEST.bak
+MYMETA.*
+MYMETA.yml
+Makefile
+Makefile.old
+Parameters.bs
+Parameters.c
+Parameters.o
+Parameters.i
+blib/
+pm_to_blib
+*.tar.gz
+/Function-Parameters-*/
0.05_02 2012-06-17
- complete rewrite in XS
- hopefully fix bug where it would get the line numbers wrong
- - lexical pragma, remove import_into
- - requires perl 5.14+
+ - we're a lexical pragma now; remove import_into()
+ - require perl 5.14+
0.05 2011-08-02
- complete rewrite
- hopefully fix bug where it would swallow compilation errors or get the line numbers wrong
- method keyword!
- more flexible keyword customization
-
+
0.04 2010-03-03
- allow renaming the function keyword
- provide import_into so you can mess with other packages
-
+
0.03 2009-12-14
First version, released on an unsuspecting world.
sv_catpvs(gen, ")=@_;");
}
- /* fprintf(stderr, "! [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */
/* named sub */
if (saw_name) {
+ /* fprintf(stderr, "! [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */
lex_stuff_sv(gen, SvUTF8(gen));
*pop = parse_barestmt(0);
return KEYWORD_PLUGIN_STMT;
/* anon sub */
sv_catpvs(gen, "BEGIN{" MY_PKG "::_fini}");
+ /* fprintf(stderr, "!> [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */
lex_stuff_sv(gen, SvUTF8(gen));
*pop = parse_arithexpr(0);
s = PL_parser->bufptr;
croak("%s: internal error: expected '}', found '%c'", MY_PKG, *s);
}
lex_unstuff(s + 1);
+ /* fprintf(stderr, "!< [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */
return KEYWORD_PLUGIN_EXPR;
}
static int magic_free(pTHX_ SV *sv, MAGIC *mg) {
lex_stuff_pvn("}", 1, 0);
+ /* fprintf(stderr, "!~ [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */
return 0;
}
? $proto
: [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
;
- my ($name, $type) = @$item;
+ my ($name, $proto_type) = @$item;
_assert_valid_identifier $name;
- unless (ref $type) {
- # use '||' instead of 'or' to preserve $type in the error message
- $type = $type_map{$type}
- || confess qq["$type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
+ unless (ref $proto_type) {
+ # use '||' instead of 'or' to preserve $proto_type in the error message
+ $proto_type = $type_map{$proto_type}
+ || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
}
- $type->{name} ||= 'optional';
- $type->{name} =~ /^(?:optional|required|prohibited)\z/
- or confess qq["$type->{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
- $type->{shift} and _assert_valid_identifier $type->{shift}, 1;
- $type->{attrs} and _assert_valid_attributes $type->{attrs};
+ my %type = %$proto_type;
+ my %clean;
+
+ $clean{name} = delete $type{name} || 'optional';
+ $clean{name} =~ /^(?:optional|required|prohibited)\z/
+ or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
+
+ $clean{shift} = delete $type{shift} || '';
+ _assert_valid_identifier $clean{shift}, 1 if $clean{shift};
+
+ $clean{attrs} = delete $type{attrs} || '';
+ _assert_valid_attributes $clean{attrs} if $clean{attrs};
- $spec{$name} = $type;
+ %type and confess "Invalid keyword property: @{[keys %type]}";
+
+ $spec{$name} = \%clean;
}
for my $kw (keys %spec) {
my $type = $spec{$kw};
- $^H{HINTK_SHIFT_ . $kw} = $type->{shift} || '';
- $^H{HINTK_ATTRS_ . $kw} = $type->{attrs} || '';
+ $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
+ $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
$^H{HINTK_NAME_ . $kw} =
$type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED :
$type->{name} eq 'required' ? FLAG_NAME_REQUIRED :
--- /dev/null
+#!perl
+
+use Test::More tests => 10;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Function::Parameters {
+ fun => 'function',
+ method => 'method',
+ elrond => {
+ attrs => ':lvalue',
+ },
+};
+
+is eval('use Function::Parameters { fun => { attrs => "nope" } }; 1'), undef;
+like $@, qr/nope.*attributes/;
+
+is eval('use Function::Parameters { fun => { attrs => ": in valid {" } }; 1'), undef;
+like $@, qr/in valid.*attributes/;
+
+elrond hobbard($ref) { $$ref }
+{
+ my $x = 1;
+ hobbard(\$x) = 'bling';
+ is $x, 'bling';
+
+}
+$_ = 'fool';
+chop hobbard \$_;
+is $_, 'foo';
+
+{
+ package BatCountry;
+
+ fun join($group, $peer) {
+ return "* $peer has joined $group";
+ }
+
+ ::is eval('join("left", "right")'), undef;
+ ::like $@, qr/Ambiguous.*CORE::/;
+}
+
+{
+ package CatCountry;
+
+ method join($peer) {
+ return "* $peer has joined $self->{name}";
+ }
+
+ ::is join('!', 'left', 'right'), 'left!right';
+
+ my $obj = bless {name => 'kittens'};
+ ::is $obj->join("twig"), "* twig has joined kittens";
+}
+#!perl
use strict;
use Function::Parameters;
fun get_ip( $agent ) {
}
+'ok'
use Dir::Self;
-for my $thing (map [__DIR__ . "/eating_strict_error$_->[0].fail", @$_[1 .. $#$_]], ['', 5], ['_2', 8]) {
+for my $thing (map [__DIR__ . "/eating_strict_error$_->[0].fail", @$_[1 .. $#$_]], ['', 6], ['_2', 9]) {
my ($file, $line) = @$thing;
+ $@ = undef;
my $done = do $file;
my $exc = $@;
my $err = $!;
+#!perl
use strict;
use Function::Parameters;
}
}
+'ok'
--- /dev/null
+#!perl
+
+use Test::More tests => 16;
+
+use warnings FATAL => 'all';
+use strict;
+
+sub Burlap::fun (&) { $_[0]->() }
+
+{
+ use Function::Parameters;
+
+ is fun { 2 + 2 }->(), 4;
+
+ package Burlap;
+
+ ::ok fun { 0 };
+}
+
+{
+ package Burlap;
+
+ ::is fun { 'singing' }, 'singing';
+}
+
+{
+ sub proc (&) { &Burlap::fun }
+
+ use Function::Parameters { proc => 'function' };
+
+ proc add($x, $y) {
+ return $x + $y;
+ }
+
+ is add(@{[2, 3]}), 5;
+
+ {
+ use Function::Parameters;
+
+ is proc () { 'bla' }->(), 'bla';
+ is method () { $self }->('der'), 'der';
+
+ {
+ no Function::Parameters;
+
+ is proc { 'unk' }, 'unk';
+
+ is eval('fun foo($x) { $x; } 1'), undef;
+ like $@, qr/syntax error/;
+ }
+
+ is proc () { 'bla' }->(), 'bla';
+ is method () { $self }->('der'), 'der';
+
+ no Function::Parameters 'proc';
+ is proc { 'unk2' }, 'unk2';
+ is method () { $self }->('der2'), 'der2';
+ }
+ is proc () { 'bla3' }->(), 'bla3';
+ is eval('fun foo($x) { $x; } 1'), undef;
+ like $@, qr/syntax error/;
+}
--- /dev/null
+#!perl
+
+use Test::More tests => 11;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Function::Parameters;
+
+fun four { 2 + 2 } fun five() { 1 + four }
+
+fun quantum :() {; 0xf00d
+}
+
+is four, 4, "basic sanity 1";
+is five, 5, "basic sanity 2";
+is quantum, 0xf00d, "basic sanity 3";
+is quantum / 2 #/
+, 0xf00d / 2, "basic sanity 4 - () proto";
+
+is eval('my $x = fun forbidden {}'), undef, "statements aren't expressions";
+like $@, qr/syntax error/;
+
+is eval('my $x = { fun forbidden {} }'), undef, "statements aren't expressions 2 - electric boogaloo";
+like $@, qr/syntax error/;
+
+is fun { join '.', five, four }->(), '5.4', "can immedicall anon subs";
+
+is 0 * fun {} + 42, 42, "* binds tighter than +";
+is 0 * fun { quantum / q#/ }
+# } + 42, 42, "* binds tighter than + 2 - electric boogaloo";
use warnings;
use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
use Dir::Self;
['2', qr/expect.*\).*after.*"\@x".*"\$y"/],
['3', qr/expect.*\).*after.*"%y".*"\$z"/],
['4', qr/expect.*\).*after.*"\@y".*"\@z"/],
+ ['5', qr/Invalid.*rarity/],
) {
my ($file, $pat) = @$fail;
+ $@ = undef;
my $done = do $file;
my $exc = $@;
my $err = $!;
use Function::Parameters;
fun bad_1($x, @y, $z) {}
+
+'ok'
use Function::Parameters;
fun bad_2(@x, $y) {}
+
+'ok'
use Function::Parameters;
fun bad_3($x, %y, $z) {}
+
+'ok'
use Function::Parameters;
fun bad_4(@y, @z) {}
+
+'ok'
--- /dev/null
+#!perl
+use warnings;
+use strict;
+
+use Function::Parameters {
+ spike => {
+ rarity => 'best',
+ },
+};
+
+'ok'
projects / p5sagit/Function-Parameters.git / commitdiff