In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/34daab0fa047b2849547189ae5f48b276658af01?hp=69a8a234c3a2ac32565c2a341127dbd2cbf56025>
- Log -----------------------------------------------------------------
commit 34daab0fa047b2849547189ae5f48b276658af01
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Fri Jan 27 10:23:12 2012 +0100
Allow prototypes (_@) and (_%)
Those will be equivalent to (_;@) and (_;%) ; since perlsub already
states that the semicolon is redundant before @ and % this is in
line with the existing documentation.
M op.c
M pod/perlsub.pod
M t/comp/uproto.t
M toke.c
commit cc2cb33e7c6571bb162ba54eeb5765e0edcd76d1
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Fri Jan 27 09:59:54 2012 +0100
Show test names in output
M t/comp/uproto.t
-----------------------------------------------------------------------
Summary of changes:
op.c | 2 +-
pod/perlsub.pod | 6 +++---
t/comp/uproto.t | 27 +++++++++++++++++++++------
toke.c | 2 +-
4 files changed, 26 insertions(+), 11 deletions(-)
diff --git a/op.c b/op.c
index 30cc7f8..479d2ba 100644
--- a/op.c
+++ b/op.c
@@ -9145,7 +9145,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV
*namegv, SV *protosv)
continue;
case '_':
/* _ must be at the end */
- if (proto[1] && proto[1] != ';')
+ if (proto[1] && !strchr(";@%", proto[1]))
goto oops;
case '$':
proto++;
diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index 1add95f..9d6fd25 100644
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -1136,9 +1136,9 @@ is of an acceptable type.
A semicolon (C<;>) separates mandatory arguments from optional arguments.
It is redundant before C<@> or C<%>, which gobble up everything else.
-As the last character of a prototype, or just before a semicolon, you can
-use C<_> in place of C<$>: if this argument is not provided, C<$_> will be
-used instead.
+As the last character of a prototype, or just before a semicolon, a C<@>
+or a C<%>, you can use C<_> in place of C<$>: if this argument is not
+provided, C<$_> will be used instead.
Note how the last three examples in the table above are treated
specially by the parser. C<mygrep()> is parsed as a true list
diff --git a/t/comp/uproto.t b/t/comp/uproto.t
index 6d251da..d3ad19f 100644
--- a/t/comp/uproto.t
+++ b/t/comp/uproto.t
@@ -1,6 +1,6 @@
#!perl
-print "1..39\n";
+print "1..43\n";
my $test = 0;
sub failed {
@@ -19,10 +19,10 @@ sub failed {
}
sub like {
- my ($got, $pattern) = @_;
+ my ($got, $pattern, $name) = @_;
$test = $test + 1;
if (defined $got && $got =~ $pattern) {
- print "ok $test\n";
+ print "ok $test - $name\n";
# Principle of least surprise - maintain the expected interface, even
# though we aren't using it here (yet).
return 1;
@@ -31,17 +31,17 @@ sub like {
}
sub is {
- my ($got, $expect) = @_;
+ my ($got, $expect, $name) = @_;
$test = $test + 1;
if (defined $expect) {
if (defined $got && $got eq $expect) {
- print "ok $test\n";
+ print "ok $test - $name\n";
return 1;
}
failed($got, "'$expect'", $name);
} else {
if (!defined $got) {
- print "ok $test\n";
+ print "ok $test - $name\n";
return 1;
}
failed($got, 'undef', $name);
@@ -120,6 +120,21 @@ $expected = $_ = "mydir"; mymkdir();
mymkdir($expected = "foo");
$expected = "foo 493"; mymkdir foo => 0755;
+sub mylist (_@) { is("@_", $expected, "mylist") }
+$expected = "foo";
+$_ = "foo";
+mylist();
+$expected = "10 11 12 13";
+mylist(10, 11 .. 13);
+
+sub mylist2 (_%) { is("@_", $expected, "mylist2") }
+$expected = "foo";
+$_ = "foo";
+mylist2();
+$expected = "10 a 1";
+my %hash = (a => 1);
+mylist2(10, %hash);
+
# $_ says modifiable, it's not passed by copy
sub double(_) { $_[0] *= 2 }
diff --git a/toke.c b/toke.c
index baa21d6..7893eb4 100644
--- a/toke.c
+++ b/toke.c
@@ -8150,7 +8150,7 @@ Perl_yylex(pTHX)
}
else {
if ( underscore ) {
- if ( *p != ';' )
+ if ( !strchr(";@%", *p) )
bad_proto = TRUE;
underscore = FALSE;
}
--
Perl5 Master Repository
