In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/a67abb3a612378541686808d03031e4055824b7d?hp=f2f8fd84e14dfcfc614b0ccf9b24475ca5f173d4>
- Log -----------------------------------------------------------------
commit a67abb3a612378541686808d03031e4055824b7d
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 15 12:45:28 2011 -0700
generic perldelta entry for prototype changes
M pod/perldelta.pod
commit 0bbad7483f446e61b319d774f9c5d184a33ea442
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 15 09:28:51 2011 -0700
&CORE::not and &CORE::getprotobynumber
These two are now supported. They were not before, because their
prototypes gave them unary precedence, even though these ops both
have list precedence. That was corrected in the previous commit.
M gv.c
M lib/CORE.pod
M pod/perldelta.pod
M t/op/coreinline.t
commit dcbdef25d6257b5884d709cd40a0fdf5314546ef
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 15 09:23:50 2011 -0700
Give not and getprotobynumber listop prototypes
They parse as list operators, but their prototypes imply unop
precedence.
M op.c
M t/op/cproto.t
commit 3a8944db48a72ff3e936211f8b0433b10f3c6c80
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 15 09:20:08 2011 -0700
Document and test $; prototype syntax
This has worked this way for yonks. It is actually useful, so it might
as well be documented.
M pod/perlsub.pod
M t/comp/proto.t
-----------------------------------------------------------------------
Summary of changes:
gv.c | 5 +----
lib/CORE.pod | 2 +-
op.c | 1 +
pod/perldelta.pod | 9 +++++----
pod/perlsub.pod | 6 +++++-
t/comp/proto.t | 13 ++++++++++++-
t/op/coreinline.t | 6 +++---
t/op/cproto.t | 4 ++--
8 files changed, 30 insertions(+), 16 deletions(-)
diff --git a/gv.c b/gv.c
index 1741bda..aa306c8 100644
--- a/gv.c
+++ b/gv.c
@@ -1338,15 +1338,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN
full_len, I32 flags,
SV *opnumsv;
if (code >= 0) return gv; /* not overridable */
/* no support for \&CORE::infix;
- no support for &CORE::not or &CORE::getprotobynumber
- either, yet, as we cannot get the precedence right;
no support for funcs that take labels, as their parsing is
weird */
switch (-code) {
case KEY_and: case KEY_cmp: case KEY_CORE: case KEY_dump:
case KEY_eq: case KEY_ge:
- case KEY_getprotobynumber: case KEY_gt: case KEY_le:
- case KEY_lt: case KEY_ne: case KEY_not:
+ case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne:
case KEY_or: case KEY_x: case KEY_xor:
return gv;
}
diff --git a/lib/CORE.pod b/lib/CORE.pod
index 1a98f76..10fa424 100644
--- a/lib/CORE.pod
+++ b/lib/CORE.pod
@@ -35,7 +35,7 @@ feature is new in Perl 5.16. You can take references to
these and make
aliases. However, they can only be called as barewords; i.e., you cannot
use ampersand syntax (C<&foo>) or call them through references. See the
C<shove> example above. This works for all overridable keywords, except
-for C<dump>, C<getprotobynumber>, C<not> and the infix operators.
+for C<dump> and the infix operators.
=head1 OVERRIDING CORE FUNCTIONS
diff --git a/op.c b/op.c
index 6c46f2a..775705b 100644
--- a/op.c
+++ b/op.c
@@ -10420,6 +10420,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name,
const int code,
}
if (defgv && str[0] == '$')
str[0] = '_';
+ if (code == -KEY_not || code == -KEY_getprotobynumber) str[n++] = ';';
str[n++] = '\0';
sv_setpvn(sv, str, n - 1);
if (opnum) *opnum = i;
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 2309a09..6b68c5a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -37,8 +37,8 @@ must be called as barewords. In other words, you can now do
this:
BEGIN { *entangle = \&CORE::tie }
entangle $variable, $package, @args;
-This currently works for overridable keywords other than C<not>, C<dump>,
-C<getprotobynumber> and the infix operators.
+This currently works for overridable keywords other than C<dump> and the
+infix operators.
Work is under way to allow these subroutines to be called through
references.
@@ -490,8 +490,9 @@ no-op otherwise), but that may be rectified in a future
version.
=item *
-C<lock>'s prototype has been corrected to C<(\[$@%&*])> from C<(\$)>, which
-was just wrong.
+The prototypes of several built-in functions--C<getprotobynumber>, C<lock>,
+C<not> and C<select>--have been corrected, or at least are now closer to
+reality than before.
=item *
diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index d344c47..e2a9bcf 100644
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -1149,7 +1149,11 @@ arguments, just like C<time()>. That is, if you say
mytime +2;
you'll get C<mytime() + 2>, not C<mytime(2)>, which is how it would be parsed
-without a prototype.
+without a prototype. If you want to force a unary function to have the
+same precedence as a list operator, add C<;> to the end of the prototype:
+
+ sub mygetprotobynumber($;);
+ mygetprotobynumber $a > $b; # parsed as mygetprotobynumber($a > $b)
The interesting thing about C<&> is that you can generate new syntax with it,
provided it's in the initial position:
diff --git a/t/comp/proto.t b/t/comp/proto.t
index 50aebef..2394164 100644
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
# strict
use strict;
-print "1..174\n";
+print "1..177\n";
my $i = 1;
@@ -700,6 +700,17 @@ print "not "
unless eval 'sub uniproto9 (;+) {} uniproto9 $_, 1' or warn $@;
print "ok ", $i++, "\n";
+# Test that a trailing semicolon makes a sub have listop precedence
+sub unilist ($;) { $_[0]+1 }
+sub unilist2(_;) { $_[0]+1 }
+sub unilist3(;$;) { $_[0]+1 }
+print "not " unless (unilist 0 || 5) == 6;
+print "ok ", $i++, "\n";
+print "not " unless (unilist2 0 || 5) == 6;
+print "ok ", $i++, "\n";
+print "not " unless (unilist3 0 || 5) == 6;
+print "ok ", $i++, "\n";
+
{
# Lack of prototype on a subroutine definition should override any prototype
# on the declaration.
diff --git a/t/op/coreinline.t b/t/op/coreinline.t
index ce3ce37..fb5c44e 100644
--- a/t/op/coreinline.t
+++ b/t/op/coreinline.t
@@ -12,7 +12,7 @@ use B::Deparse;
my $bd = new B::Deparse '-p';
my %unsupported = map +($_=>1), qw (CORE and cmp dump eq ge gt le
- getprotobynumber lt ne not or x xor);
+ lt ne or x xor);
my %args_for = (
dbmopen => '%1,$2,$3',
dbmclose => '%1',
@@ -77,8 +77,8 @@ while(<$kh>) {
next if ($proto =~ /\@/);
# These ops currently accept any number of args, despite their
# prototypes, if they have any:
- next if $word =~ /^(?:chom?p|exec|keys|each|read(?:lin|pip)e|reset
- |system|values|l?stat)/x;
+ next if $word =~ /^(?:chom?p|exec|keys|each|not|read(?:lin|pip)e
+ |reset|system|values|l?stat)/x;
$tests ++;
$code =
diff --git a/t/op/cproto.t b/t/op/cproto.t
index e995416..a587a31 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -105,7 +105,7 @@ getpgrp (;$)
getppid ()
getpriority ($$)
getprotobyname ($)
-getprotobynumber ($)
+getprotobynumber ($;)
getprotoent ()
getpwent ()
getpwnam ($)
@@ -153,7 +153,7 @@ my undef
ne undef
next undef
no undef
-not ($)
+not ($;)
oct (_)
open (*;$@)
opendir (*$)
--
Perl5 Master Repository
