In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/9fc60eb3f528bacd721b8852138528a61c555fb7?hp=1d51ab6ca7dce64da157c7a48bf6431086a32ed2>
- Log -----------------------------------------------------------------
commit 9fc60eb3f528bacd721b8852138528a61c555fb7
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 28 16:44:56 2014 -0800
Remove ârequire Configâ from ref.t
82b84d04879 removed the code that needed it.
M t/op/ref.t
commit 4964f676ab84eee840a22ed626f8a1a15b9370dd
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 28 16:09:12 2014 -0800
perlfunc: prototype implies $_
M pod/perlfunc.pod
commit eb4ec35b34d91de654d6eb753c89dca0b28c7a07
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 28 16:08:19 2014 -0800
[perl #123514] Make prototype() imply $_
Previously it would read and replace the previous item on the stack:
$ ./perl -le 'print "CORE::undef", prototype'
;\[$@%&*]
M embed.h
M op.c
M opcode.h
M proto.h
M regen/opcodes
M t/comp/proto.t
M t/op/cproto.t
-----------------------------------------------------------------------
Summary of changes:
embed.h | 1 +
op.c | 11 +++++++++++
opcode.h | 4 ++--
pod/perlfunc.pod | 5 ++++-
proto.h | 6 ++++++
regen/opcodes | 2 +-
t/comp/proto.t | 8 +++++++-
t/op/cproto.t | 2 +-
t/op/ref.t | 2 --
9 files changed, 33 insertions(+), 8 deletions(-)
diff --git a/embed.h b/embed.h
index c52446a..49d9ee8 100644
--- a/embed.h
+++ b/embed.h
@@ -1109,6 +1109,7 @@
#define ck_method(a) Perl_ck_method(aTHX_ a)
#define ck_null(a) Perl_ck_null(aTHX_ a)
#define ck_open(a) Perl_ck_open(aTHX_ a)
+#define ck_prototype(a) Perl_ck_prototype(aTHX_ a)
#define ck_readline(a) Perl_ck_readline(aTHX_ a)
#define ck_refassign(a) Perl_ck_refassign(aTHX_ a)
#define ck_repeat(a) Perl_ck_repeat(aTHX_ a)
diff --git a/op.c b/op.c
index 981ca3c..5a6e896 100644
--- a/op.c
+++ b/op.c
@@ -10618,6 +10618,17 @@ Perl_ck_open(pTHX_ OP *o)
}
OP *
+Perl_ck_prototype(pTHX_ OP *o)
+{
+ PERL_ARGS_ASSERT_CK_PROTOTYPE;
+ if (!(o->op_flags & OPf_KIDS)) {
+ op_free(o);
+ return newUNOP(OP_PROTOTYPE, 0, newDEFSVOP());
+ }
+ return o;
+}
+
+OP *
Perl_ck_refassign(pTHX_ OP *o)
{
OP * const right = cLISTOPo->op_first;
diff --git a/opcode.h b/opcode.h
index cbd348d..d24dc18 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1376,7 +1376,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_null, /* av2arylen */
Perl_ck_rvconst, /* rv2cv */
Perl_ck_anoncode, /* anoncode */
- Perl_ck_null, /* prototype */
+ Perl_ck_prototype, /* prototype */
Perl_ck_spair, /* refgen */
Perl_ck_null, /* srefgen */
Perl_ck_fun, /* ref */
@@ -1775,7 +1775,7 @@ EXTCONST U32 PL_opargs[] = {
0x00000104, /* av2arylen */
0x00000140, /* rv2cv */
0x00000604, /* anoncode */
- 0x00001b04, /* prototype */
+ 0x00009b84, /* prototype */
0x00002101, /* refgen */
0x00001106, /* srefgen */
0x00009b8c, /* ref */
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index e7ccfa4..ce945eb 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -5352,11 +5352,14 @@ error prone.
=item prototype FUNCTION
X<prototype>
+=item prototype
+
=for Pod::Functions +5.002 get the prototype (if any) of a subroutine
Returns the prototype of a function as a string (or C<undef> if the
function has no prototype). FUNCTION is a reference to, or the name of,
-the function whose prototype you want to retrieve.
+the function whose prototype you want to retrieve. If FUNCTION is omitted,
+$_ is used.
If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
name for a Perl builtin. If the builtin's arguments
diff --git a/proto.h b/proto.h
index c27e50b..cf8e93d 100644
--- a/proto.h
+++ b/proto.h
@@ -570,6 +570,12 @@ PERL_CALLCONV OP * Perl_ck_open(pTHX_ OP *o)
#define PERL_ARGS_ASSERT_CK_OPEN \
assert(o)
+PERL_CALLCONV OP * Perl_ck_prototype(pTHX_ OP *o)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CK_PROTOTYPE \
+ assert(o)
+
PERL_CALLCONV OP * Perl_ck_readline(pTHX_ OP *o)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
diff --git a/regen/opcodes b/regen/opcodes
index 4ab05e0..4d5770e 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -66,7 +66,7 @@ rv2sv scalar dereference ck_rvconst ds1
av2arylen array length ck_null is1
rv2cv subroutine dereference ck_rvconst d1
anoncode anonymous subroutine ck_anoncode s$
-prototype subroutine prototype ck_null s% S
+prototype subroutine prototype ck_prototype su% S?
refgen reference constructor ck_spair m1 L
srefgen single ref constructor ck_null fs1 S
ref reference-type operator ck_fun stu% S?
diff --git a/t/comp/proto.t b/t/comp/proto.t
index ec96cad..2b983f5 100644
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
# strict
use strict;
-print "1..214\n";
+print "1..215\n";
my $i = 1;
@@ -885,3 +885,9 @@ print "ok ", $i++, "\n";
print "not ok ", $i++, " # >@got<\n";
}
}
+
+# [perl #123514] prototype with no arguments
+$_ = sub ($$$$$$$) {};
+@_ = (1, 2, 3, prototype(), 4, 5, 6);
+print "not " unless "@_" eq '1 2 3 $$$$$$$ 4 5 6';
+print "ok ", $i++, " - [perl #123514] (got @_)\n";
diff --git a/t/op/cproto.t b/t/op/cproto.t
index 85b86db..b2f07f7 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -180,7 +180,7 @@ pop (;+)
pos (;\[$*])
print undef
printf undef
-prototype ($)
+prototype (_)
push (+@)
q undef
qq undef
diff --git a/t/op/ref.t b/t/op/ref.t
index c686fa8..19a44bb 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -798,7 +798,6 @@ for (3) {
eval { $_ = 4 };
like $@, qr/^Modification of a read-only/,
'assignment to value aliased to literal number';
- require Config;
eval { ${\$_} = 4 };
like $@, qr/^Modification of a read-only/,
'refgen does not allow assignment to value aliased to literal number';
@@ -807,7 +806,6 @@ for ("4eounthouonth") {
eval { $_ = 4 };
like $@, qr/^Modification of a read-only/,
'assignment to value aliased to literal string';
- require Config;
eval { ${\$_} = 4 };
like $@, qr/^Modification of a read-only/,
'refgen does not allow assignment to value aliased to literal string';
--
Perl5 Master Repository
