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. Cmygrep() 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
