summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dump.c1
-rw-r--r--embed.fnc5
-rw-r--r--embed.h3
-rw-r--r--ext/B/B.pm2
-rw-r--r--ext/B/B.xs32
-rw-r--r--ext/B/B/Concise.pm8
-rw-r--r--ext/Opcode/Opcode.pm4
-rw-r--r--lib/B/Deparse.pm62
-rw-r--r--lib/B/Op_private.pm37
-rw-r--r--op.c40
-rw-r--r--opcode.h145
-rw-r--r--opnames.h417
-rw-r--r--perly.act500
-rw-r--r--perly.h2
-rw-r--r--perly.tab40
-rw-r--r--perly.y190
-rw-r--r--pod/perldiag.pod20
-rw-r--r--pp.c206
-rw-r--r--pp_hot.c22
-rw-r--r--pp_proto.h3
-rw-r--r--proto.h7
-rw-r--r--regen/op_private12
-rw-r--r--regen/opcodes3
-rw-r--r--t/op/signatures.t17
-rw-r--r--toke.c38
25 files changed, 1031 insertions, 785 deletions
diff --git a/dump.c b/dump.c
index c168162791..5b3dfca62f 100644
--- a/dump.c
+++ b/dump.c
@@ -2514,6 +2514,7 @@ Perl_debop(pTHX_ const OP *o)
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
+ case OP_ARGELEM:
S_deb_padvar(aTHX_ o->op_targ, 1, 1);
break;
diff --git a/embed.fnc b/embed.fnc
index 6505d18afd..adccf0c8e3 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -298,6 +298,7 @@ Anprd |void |croak_xs_usage |NN const CV *const cv \
|NN const char *const params
npr |void |croak_no_mem
nprX |void |croak_popstack
+fnrp |void |croak_caller|NULLOK const char* pat|...
fnprx |void |noperl_die|NN const char* pat|...
#if defined(WIN32)
norx |void |win32_croak_not_implemented|NN const char * fname
@@ -2533,7 +2534,7 @@ s |int |intuit_more |NN char *s
s |I32 |lop |I32 f|int x|NN char *s
rs |void |missingterm |NULLOK char *s
s |void |no_op |NN const char *const what|NULLOK char *s
-s |int |pending_ident
+s |int |pending_ident |bool is_sig
sR |I32 |sublex_done
sR |I32 |sublex_push
sR |I32 |sublex_start
@@ -2990,6 +2991,4 @@ XEop |void |dtrace_probe_op |NN const OP *op
XEop |void |dtrace_probe_phase|enum perl_phase phase
#endif
-xpo |OP* |check_arity |int arity |bool max
-
: ex: set ts=8 sts=4 sw=4 noet:
diff --git a/embed.h b/embed.h
index e5cd19365c..930ea9142d 100644
--- a/embed.h
+++ b/embed.h
@@ -1202,6 +1202,7 @@
#define core_prototype(a,b,c,d) Perl_core_prototype(aTHX_ a,b,c,d)
#define coresub_op(a,b,c) Perl_coresub_op(aTHX_ a,b,c)
#define create_eval_scope(a,b) Perl_create_eval_scope(aTHX_ a,b)
+#define croak_caller Perl_croak_caller
#define croak_no_mem Perl_croak_no_mem
#define croak_popstack Perl_croak_popstack
#define custom_op_get_field(a,b) Perl_custom_op_get_field(aTHX_ a,b)
@@ -1786,7 +1787,7 @@
#define missingterm(a) S_missingterm(aTHX_ a)
#define no_op(a,b) S_no_op(aTHX_ a,b)
#define parse_ident(a,b,c,d,e,f) S_parse_ident(aTHX_ a,b,c,d,e,f)
-#define pending_ident() S_pending_ident(aTHX)
+#define pending_ident(a) S_pending_ident(aTHX_ a)
#define scan_const(a) S_scan_const(aTHX_ a)
#define scan_formline(a) S_scan_formline(aTHX_ a)
#define scan_heredoc(a) S_scan_heredoc(aTHX_ a)
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 5c1e5997b8..ffe97248d6 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.62';
+ $B::VERSION = '1.63';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
diff --git a/ext/B/B.xs b/ext/B/B.xs
index b4b6a40ac5..4e35c03c81 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1325,14 +1325,30 @@ string(o, cv)
B::CV cv
PREINIT:
SV *ret;
+ UNOP_AUX_item *aux;
PPCODE:
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
case OP_MULTIDEREF:
ret = multideref_stringify(o, cv);
break;
+
+ case OP_ARGELEM:
+ ret = sv_2mortal(Perl_newSVpvf(aTHX_ "%"UVuf,
+ PTR2UV(aux)));
+ break;
+
+ case OP_ARGCHECK:
+ ret = Perl_newSVpvf(aTHX_ "%"UVuf",%"UVuf, aux[0].uv, aux[1].uv);
+ if (aux[2].iv)
+ Perl_sv_catpvf(aTHX_ ret, ",%c", (char)aux[2].iv);
+ ret = sv_2mortal(ret);
+ break;
+
default:
ret = sv_2mortal(newSVpvn("", 0));
}
+
ST(0) = ret;
XSRETURN(1);
@@ -1346,12 +1362,28 @@ void
aux_list(o, cv)
B::OP o
B::CV cv
+ PREINIT:
+ UNOP_AUX_item *aux;
PPCODE:
PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
default:
XSRETURN(0); /* by default, an empty list */
+ case OP_ARGELEM:
+ XPUSHs(sv_2mortal(newSVuv(PTR2UV(aux))));
+ XSRETURN(1);
+ break;
+
+ case OP_ARGCHECK:
+ EXTEND(SP, 3);
+ PUSHs(sv_2mortal(newSVuv(aux[0].uv)));
+ PUSHs(sv_2mortal(newSVuv(aux[1].uv)));
+ PUSHs(sv_2mortal(aux[2].iv ? Perl_newSVpvf(aTHX_ "%c",
+ (char)aux[2].iv) : &PL_sv_no));
+ break;
+
case OP_MULTIDEREF:
#ifdef USE_ITHREADS
# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 311e0e738a..26eb8c569f 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
use Exporter (); # use #5
-our $VERSION = "0.996";
+our $VERSION = "0.997";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
@@ -820,6 +820,7 @@ sub concise_op {
$h{targarg} = join '; ', @targarg;
$h{targarglife} = join '; ', @targarglife;
}
+
$h{arg} = "";
$h{svclass} = $h{svaddr} = $h{svval} = "";
if ($h{class} eq "PMOP") {
@@ -884,6 +885,11 @@ sub concise_op {
undef $lastnext;
$h{arg} = "(other->" . seq($op->other) . ")";
$h{otheraddr} = sprintf("%#x", $ {$op->other});
+ if ($h{name} eq "argdefelem") {
+ # targ used for element index
+ $h{targarglife} = $h{targarg} = "";
+ $h{arg} .= "[" . $op->targ . "]";
+ }
}
elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 9d667c276b..f4925324f3 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.35";
+$VERSION = "1.36";
use Carp;
use Exporter ();
@@ -312,7 +312,7 @@ invert_opset function.
av2arylen
rv2hv helem hslice kvhslice each values keys exists delete
- aeach akeys avalues multideref
+ aeach akeys avalues multideref argelem argdefelem argcheck
preinc i_preinc predec i_predec postinc i_postinc
postdec i_postdec int hex oct abs pow multiply i_multiply
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 9879d678b1..7e4c55ce1a 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -46,7 +46,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
MDEREF_SHIFT
);
-$VERSION = '1.37';
+$VERSION = '1.38';
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1256,6 +1256,11 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
push @ops, $o;
}
$body = $self->lineseq(undef, 0, @ops).";";
+ if ($ops[-1]->name =~ /^(next|db)state$/) {
+ # this handles void context in
+ # use feature signatures; sub ($=1) {}
+ $body .= "\n()";
+ }
my $scope_en = $self->find_scope_en($lineseq);
if (defined $scope_en) {
my $subs = join"", $self->seq_subs($scope_en);
@@ -5772,6 +5777,61 @@ sub pp_lvavref {
: &pp_padsv) . ')'
}
+
+sub pp_argcheck {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my ($params, $opt_params, $slurpy) = $op->aux_list($self->{curcv});
+ my $mandatory = $params - $opt_params;
+ my $check = '';
+
+ $check .= <<EOF if !$slurpy;
+die sprintf("Too many arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ <= $params;
+EOF
+
+ $check .= <<EOF if $mandatory > 0;
+die sprintf("Too few arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ >= $mandatory;
+EOF
+
+ my $cond = ($params & 1) ? 'unless' : 'if';
+ $check .= <<EOF if $slurpy eq '%';
+die sprintf("Odd name/value argument for subroutine at %s line %d.\\n", (caller)[1, 2]) if \@_ > $params && ((\@_ - $params) & 1);
+EOF
+
+ $check =~ s/;\n\z//;
+ return $check;
+}
+
+
+sub pp_argelem {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my $var = $self->padname($op->targ);
+ my $ix = $op->string($self->{curcv});
+ my $expr;
+ if ($op->flags & OPf_KIDS) {
+ $expr = $self->deparse($op->first, 7);
+ }
+ elsif ($var =~ /^[@%]/) {
+ $expr = $ix ? "\@_[$ix .. \$#_]" : '@_';
+ }
+ else {
+ $expr = "\$_[$ix]";
+ }
+ return "my $var = $expr";
+}
+
+
+sub pp_argdefelem {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my $ix = $op->targ;
+ my $expr = "\@_ >= " . ($ix+1) . " ? \$_[$ix] : ";
+ $expr .= $self->deparse($op->first, $cx);
+ return $expr;
+}
+
+
1;
__END__
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 7931cb2bff..23ce78e6ee 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -208,6 +208,17 @@ my @bf = (
bitmask => 255,
},
{
+ mask_def => 'OPpARGELEM_MASK',
+ bitmin => 1,
+ bitmax => 2,
+ bitmask => 6,
+ enum => [
+ 0, 'OPpARGELEM_SV', 'SV',
+ 1, 'OPpARGELEM_AV', 'AV',
+ 2, 'OPpARGELEM_HV', 'HV',
+ ],
+ },
+ {
mask_def => 'OPpDEREF',
bitmin => 4,
bitmax => 5,
@@ -237,7 +248,7 @@ $bits{abs}{0} = $bf[0];
@{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{add}}{1,0} = ($bf[1], $bf[1]);
$bits{aeach}{0} = $bf[0];
-@{$bits{aelem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]);
+@{$bits{aelem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
$bits{akeys}{0} = $bf[0];
@@ -247,6 +258,9 @@ $bits{andassign}{0} = $bf[0];
$bits{anonconst}{0} = $bf[0];
@{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
+$bits{argcheck}{0} = $bf[0];
+$bits{argdefelem}{0} = $bf[0];
+@{$bits{argelem}}{2,1,0} = ($bf[7], $bf[7], $bf[0]);
@{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{av2arylen}{0} = $bf[0];
$bits{avalues}{0} = $bf[0];
@@ -290,7 +304,7 @@ $bits{each}{0} = $bf[0];
@{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]);
$bits{entergiven}{0} = $bf[0];
$bits{enteriter}{3} = 'OPpITER_DEF';
-@{$bits{entersub}}{5,4,0} = ($bf[7], $bf[7], 'OPpENTERSUB_INARGS');
+@{$bits{entersub}}{5,4,0} = ($bf[8], $bf[8], 'OPpENTERSUB_INARGS');
$bits{entertry}{0} = $bf[0];
$bits{enterwhen}{0} = $bf[0];
@{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@@ -361,7 +375,7 @@ $bits{grepwhile}{0} = $bf[0];
@{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gt}}{1,0} = ($bf[1], $bf[1]);
$bits{gv}{5} = 'OPpEARLY_CV';
-@{$bits{helem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]);
+@{$bits{helem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
$bits{hex}{0} = $bf[0];
@{$bits{i_add}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]);
@@ -409,7 +423,7 @@ $bits{log}{0} = $bf[0];
$bits{lstat}{0} = $bf[0];
@{$bits{lt}}{1,0} = ($bf[1], $bf[1]);
$bits{lvavref}{0} = $bf[0];
-@{$bits{lvref}}{5,4,0} = ($bf[8], $bf[8], $bf[0]);
+@{$bits{lvref}}{5,4,0} = ($bf[9], $bf[9], $bf[0]);
$bits{mapstart}{0} = $bf[0];
$bits{mapwhile}{0} = $bf[0];
$bits{method}{0} = $bf[0];
@@ -443,7 +457,7 @@ $bits{orassign}{0} = $bf[0];
$bits{ord}{0} = $bf[0];
@{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]);
-@{$bits{padsv}}{5,4} = ($bf[7], $bf[7]);
+@{$bits{padsv}}{5,4} = ($bf[8], $bf[8]);
@{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{pop}{0} = $bf[0];
$bits{pos}{0} = $bf[0];
@@ -464,7 +478,7 @@ $bits{readlink}{0} = $bf[0];
@{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{redo}{0} = $bf[0];
$bits{ref}{0} = $bf[0];
-@{$bits{refassign}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
+@{$bits{refassign}}{5,4,1,0} = ($bf[9], $bf[9], $bf[1], $bf[1]);
$bits{refgen}{0} = $bf[0];
$bits{regcmaybe}{0} = $bf[0];
$bits{regcomp}{0} = $bf[0];
@@ -480,9 +494,9 @@ $bits{rewinddir}{0} = $bf[0];
$bits{rmdir}{0} = $bf[0];
$bits{rv2av}{0} = $bf[0];
@{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]);
-@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[7], $bf[7], 'OPpDONT_INIT_GV', $bf[0]);
+@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[8], $bf[8], 'OPpDONT_INIT_GV', $bf[0]);
$bits{rv2hv}{0} = $bf[0];
-@{$bits{rv2sv}}{5,4,0} = ($bf[7], $bf[7], $bf[0]);
+@{$bits{rv2sv}}{5,4,0} = ($bf[8], $bf[8], $bf[0]);
@{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]);
@{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]);
@@ -571,6 +585,10 @@ our %defines = (
OPpARG2_MASK => 3,
OPpARG3_MASK => 7,
OPpARG4_MASK => 15,
+ OPpARGELEM_AV => 2,
+ OPpARGELEM_HV => 4,
+ OPpARGELEM_MASK => 6,
+ OPpARGELEM_SV => 0,
OPpASSIGN_BACKWARDS => 64,
OPpASSIGN_COMMON_AGG => 16,
OPpASSIGN_COMMON_RC1 => 32,
@@ -665,6 +683,9 @@ our %defines = (
our %labels = (
OPpALLOW_FAKE => 'FAKE',
+ OPpARGELEM_AV => 'AV',
+ OPpARGELEM_HV => 'HV',
+ OPpARGELEM_SV => 'SV',
OPpASSIGN_BACKWARDS => 'BKWARD',
OPpASSIGN_COMMON_AGG => 'COM_AGG',
OPpASSIGN_COMMON_RC1 => 'COM_RC1',
diff --git a/op.c b/op.c
index 058e81c6ce..ec13eaa9d4 100644
--- a/op.c
+++ b/op.c
@@ -929,6 +929,7 @@ Perl_op_clear(pTHX_ OP *o)
/* FALLTHROUGH */
case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
+ case OP_ARGDEFELEM: /* Was holding signature index. */
o->op_targ = 0;
break;
default:
@@ -1052,6 +1053,10 @@ Perl_op_clear(pTHX_ OP *o)
break;
+ case OP_ARGCHECK:
+ PerlMemShared_free(cUNOP_AUXo->op_aux);
+ break;
+
case OP_MULTIDEREF:
{
UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
@@ -15018,41 +15023,6 @@ const_av_xsub(pTHX_ CV* cv)
XSRETURN(AvFILLp(av)+1);
}
-/* return an optree that checks for too few or too many args -
- * used for subroutine signatures
- */
-OP *
-Perl_check_arity(pTHX_ int arity, bool max)
-{
- return
- newSTATEOP(0, NULL,
- newLOGOP(OP_OR, 0,
- newBINOP((max ? OP_LE : OP_GE), 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))
- ),
- newSVOP(OP_CONST, 0, newSViv(arity))
- ),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- max
- ? newSVpvs("Too many arguments for subroutine at %s line %d.\n")
- : newSVpvs("Too few arguments for subroutine at %s line %d.\n")
- ),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0)
- )
- )
- )
- )
- )
- );
-}
/*
* ex: set ts=8 sts=4 sw=4 et:
diff --git a/opcode.h b/opcode.h
index 0aaefb64a4..24f5a672f6 100644
--- a/opcode.h
+++ b/opcode.h
@@ -334,6 +334,9 @@ EXTCONST char* const PL_op_name[] = {
"entersub",
"leavesub",
"leavesublv",
+ "argcheck",
+ "argelem",
+ "argdefelem",
"caller",
"warn",
"die",
@@ -736,6 +739,9 @@ EXTCONST char* const PL_op_desc[] = {
"subroutine entry",
"subroutine exit",
"lvalue subroutine return",
+ "check subroutine arguments",
+ "subroutine argument",
+ "subroutine argument default value",
"caller",
"warn",
"die",
@@ -1152,6 +1158,9 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
Perl_pp_entersub,
Perl_pp_leavesub,
Perl_pp_leavesublv,
+ Perl_pp_argcheck,
+ Perl_pp_argelem,
+ Perl_pp_argdefelem,
Perl_pp_caller,
Perl_pp_warn,
Perl_pp_die,
@@ -1564,6 +1573,9 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_subr, /* entersub */
Perl_ck_null, /* leavesub */
Perl_ck_null, /* leavesublv */
+ Perl_ck_null, /* argcheck */
+ Perl_ck_null, /* argelem */
+ Perl_ck_null, /* argdefelem */
Perl_ck_fun, /* caller */
Perl_ck_fun, /* warn */
Perl_ck_fun, /* die */
@@ -1970,6 +1982,9 @@ EXTCONST U32 PL_opargs[] = {
0x00002141, /* entersub */
0x00000100, /* leavesub */
0x00000100, /* leavesublv */
+ 0x00000f00, /* argcheck */
+ 0x00000f00, /* argelem */
+ 0x00000300, /* argdefelem */
0x00009b08, /* caller */
0x0000240d, /* warn */
0x0000240d, /* die */
@@ -2184,12 +2199,14 @@ EXTCONST U32 PL_opargs[] = {
END_EXTERN_C
+#define OPpARGELEM_SV 0x00
#define OPpLVREF_SV 0x00
#define OPpARG1_MASK 0x01
#define OPpCOREARGS_DEREF1 0x01
#define OPpENTERSUB_INARGS 0x01
#define OPpSORT_NUMERIC 0x01
#define OPpTRANS_FROM_UTF 0x01
+#define OPpARGELEM_AV 0x02
#define OPpCONST_NOVER 0x02
#define OPpCOREARGS_DEREF2 0x02
#define OPpEVAL_HAS_HH 0x02
@@ -2199,6 +2216,7 @@ END_EXTERN_C
#define OPpSORT_INTEGER 0x02
#define OPpTRANS_TO_UTF 0x02
#define OPpARG2_MASK 0x03
+#define OPpARGELEM_HV 0x04
#define OPpCONST_SHORTCIRCUIT 0x04
#define OPpDONT_INIT_GV 0x04
#define OPpENTERSUB_HASTARG 0x04
@@ -2208,6 +2226,7 @@ END_EXTERN_C
#define OPpSLICEWARNING 0x04
#define OPpSORT_REVERSE 0x04
#define OPpTRANS_IDENTICAL 0x04
+#define OPpARGELEM_MASK 0x06
#define OPpARG3_MASK 0x07
#define OPpPADRANGE_COUNTSHIFT 0x07
#define OPpCONST_STRICT 0x08
@@ -2411,6 +2430,7 @@ EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
0, 8, -1,
+ 1, -1, 0, 507, 1, 26, 2, 276, -1,
4, -1, 1, 157, 2, 164, 3, 171, -1,
4, -1, 0, 507, 1, 26, 2, 276, 3, 103, -1,
@@ -2609,27 +2629,30 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
137, /* entersub */
144, /* leavesub */
144, /* leavesublv */
- 146, /* caller */
+ 0, /* argcheck */
+ 146, /* argelem */
+ 0, /* argdefelem */
+ 148, /* caller */
48, /* warn */
48, /* die */
48, /* reset */
-1, /* lineseq */
- 148, /* nextstate */
- 148, /* dbstate */
+ 150, /* nextstate */
+ 150, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 149, /* leave */
+ 151, /* leave */
-1, /* scope */
- 151, /* enteriter */
- 155, /* iter */
+ 153, /* enteriter */
+ 157, /* iter */
-1, /* enterloop */
- 156, /* leaveloop */
+ 158, /* leaveloop */
-1, /* return */
- 158, /* last */
- 158, /* next */
- 158, /* redo */
- 158, /* dump */
- 158, /* goto */
+ 160, /* last */
+ 160, /* next */
+ 160, /* redo */
+ 160, /* dump */
+ 160, /* goto */
48, /* exit */
0, /* method_named */
0, /* method_super */
@@ -2641,7 +2664,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 160, /* open */
+ 162, /* open */
48, /* close */
48, /* pipe_op */
48, /* fileno */
@@ -2687,33 +2710,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 165, /* ftrread */
- 165, /* ftrwrite */
- 165, /* ftrexec */
- 165, /* fteread */
- 165, /* ftewrite */
- 165, /* fteexec */
- 170, /* ftis */
- 170, /* ftsize */
- 170, /* ftmtime */
- 170, /* ftatime */
- 170, /* ftctime */
- 170, /* ftrowned */
- 170, /* fteowned */
- 170, /* ftzero */
- 170, /* ftsock */
- 170, /* ftchr */
- 170, /* ftblk */
- 170, /* ftfile */
- 170, /* ftdir */
- 170, /* ftpipe */
- 170, /* ftsuid */
- 170, /* ftsgid */
- 170, /* ftsvtx */
- 170, /* ftlink */
- 170, /* fttty */
- 170, /* fttext */
- 170, /* ftbinary */
+ 167, /* ftrread */
+ 167, /* ftrwrite */
+ 167, /* ftrexec */
+ 167, /* fteread */
+ 167, /* ftewrite */
+ 167, /* fteexec */
+ 172, /* ftis */
+ 172, /* ftsize */
+ 172, /* ftmtime */
+ 172, /* ftatime */
+ 172, /* ftctime */
+ 172, /* ftrowned */
+ 172, /* fteowned */
+ 172, /* ftzero */
+ 172, /* ftsock */
+ 172, /* ftchr */
+ 172, /* ftblk */
+ 172, /* ftfile */
+ 172, /* ftdir */
+ 172, /* ftpipe */
+ 172, /* ftsuid */
+ 172, /* ftsgid */
+ 172, /* ftsvtx */
+ 172, /* ftlink */
+ 172, /* fttty */
+ 172, /* fttext */
+ 172, /* ftbinary */
77, /* chdir */
77, /* chown */
71, /* chroot */
@@ -2733,17 +2756,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 174, /* wait */
+ 176, /* wait */
77, /* waitpid */
77, /* system */
77, /* exec */
77, /* kill */
- 174, /* getppid */
+ 176, /* getppid */
77, /* getpgrp */
77, /* setpgrp */
77, /* getpriority */
77, /* setpriority */
- 174, /* time */
+ 176, /* time */
-1, /* tms */
0, /* localtime */
48, /* gmtime */
@@ -2763,7 +2786,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 175, /* entereval */
+ 177, /* entereval */
144, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
@@ -2802,18 +2825,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 181, /* coreargs */
- 185, /* avhvswitch */
+ 183, /* coreargs */
+ 187, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 187, /* padrange */
- 189, /* refassign */
- 195, /* lvref */
- 201, /* lvrefslice */
- 202, /* lvavref */
+ 189, /* padrange */
+ 191, /* refassign */
+ 197, /* lvref */
+ 203, /* lvrefslice */
+ 204, /* lvavref */
0, /* anonconst */
};
@@ -2833,19 +2856,19 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
*/
EXTCONST U16 PL_op_private_bitdefs[] = {
- 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
+ 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, argcheck, argdefelem, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
0x2b5c, 0x3d59, /* pushmark */
0x00bd, /* wantarray, runcv */
0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */
0x2b5c, 0x3079, /* gvsv */
0x1655, /* gv */
0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
- 0x2b5c, 0x3d58, 0x02b7, /* padsv */
+ 0x2b5c, 0x3d58, 0x03d7, /* padsv */
0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */
0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */
0x3819, /* pushre, match, qr, subst */
- 0x2b5c, 0x19d8, 0x02b6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
- 0x2b5c, 0x3078, 0x02b6, 0x3e04, 0x0003, /* rv2sv */
+ 0x2b5c, 0x19d8, 0x03d6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
+ 0x2b5c, 0x3078, 0x03d6, 0x3e04, 0x0003, /* rv2sv */
0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */
0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */
0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
@@ -2862,7 +2885,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2c4c, 0x0067, /* vec */
0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */
0x025f, /* aelemfast, aelemfast_lex */
- 0x2b5c, 0x2a58, 0x02b6, 0x2c4c, 0x0067, /* aelem, helem */
+ 0x2b5c, 0x2a58, 0x03d6, 0x2c4c, 0x0067, /* aelem, helem */
0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */
0x2c4d, /* kvaslice, kvhslice */
0x2b5c, 0x3998, 0x0003, /* delete */
@@ -2875,8 +2898,9 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x26cc, 0x0003, /* reverse */
0x28f8, 0x0003, /* flip, flop */
0x2b5c, 0x0003, /* cond_expr */
- 0x2b5c, 0x0e18, 0x02b6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
+ 0x2b5c, 0x0e18, 0x03d6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+ 0x02aa, 0x0003, /* argelem */
0x00bc, 0x018f, /* caller */
0x21f5, /* nextstate, dbstate */
0x29fc, 0x33d9, /* leave */
@@ -2892,8 +2916,8 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */
0x2c4c, 0x00c7, /* avhvswitch */
0x2b5c, 0x01fb, /* padrange */
- 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0067, /* refassign */
- 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0003, /* lvref */
+ 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0067, /* refassign */
+ 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0003, /* lvref */
0x2b5d, /* lvrefslice */
0x2b5c, 0x3d58, 0x0003, /* lvavref */
@@ -3092,6 +3116,9 @@ EXTCONST U8 PL_op_private_valid[] = {
/* ENTERSUB */ (OPpENTERSUB_INARGS|OPpHINT_STRICT_REFS|OPpENTERSUB_HASTARG|OPpENTERSUB_AMPER|OPpDEREF|OPpENTERSUB_DB|OPpLVAL_INTRO),
/* LEAVESUB */ (OPpARG1_MASK|OPpREFCOUNTED),
/* LEAVESUBLV */ (OPpARG1_MASK|OPpREFCOUNTED),
+ /* ARGCHECK */ (OPpARG1_MASK),
+ /* ARGELEM */ (OPpARG1_MASK|OPpARGELEM_MASK),
+ /* ARGDEFELEM */ (OPpARG1_MASK),
/* CALLER */ (OPpARG4_MASK|OPpOFFBYONE),
/* WARN */ (OPpARG4_MASK),
/* DIE */ (OPpARG4_MASK),
diff --git a/opnames.h b/opnames.h
index 99b19d0b99..e04d331a7c 100644
--- a/opnames.h
+++ b/opnames.h
@@ -202,216 +202,219 @@ typedef enum opcode {
OP_ENTERSUB = 185,
OP_LEAVESUB = 186,
OP_LEAVESUBLV = 187,
- OP_CALLER = 188,
- OP_WARN = 189,
- OP_DIE = 190,
- OP_RESET = 191,
- OP_LINESEQ = 192,
- OP_NEXTSTATE = 193,
- OP_DBSTATE = 194,
- OP_UNSTACK = 195,
- OP_ENTER = 196,
- OP_LEAVE = 197,
- OP_SCOPE = 198,
- OP_ENTERITER = 199,
- OP_ITER = 200,
- OP_ENTERLOOP = 201,
- OP_LEAVELOOP = 202,
- OP_RETURN = 203,
- OP_LAST = 204,
- OP_NEXT = 205,
- OP_REDO = 206,
- OP_DUMP = 207,
- OP_GOTO = 208,
- OP_EXIT = 209,
- OP_METHOD_NAMED = 210,
- OP_METHOD_SUPER = 211,
- OP_METHOD_REDIR = 212,
- OP_METHOD_REDIR_SUPER = 213,
- OP_ENTERGIVEN = 214,
- OP_LEAVEGIVEN = 215,
- OP_ENTERWHEN = 216,
- OP_LEAVEWHEN = 217,
- OP_BREAK = 218,
- OP_CONTINUE = 219,
- OP_OPEN = 220,
- OP_CLOSE = 221,
- OP_PIPE_OP = 222,
- OP_FILENO = 223,
- OP_UMASK = 224,
- OP_BINMODE = 225,
- OP_TIE = 226,
- OP_UNTIE = 227,
- OP_TIED = 228,
- OP_DBMOPEN = 229,
- OP_DBMCLOSE = 230,
- OP_SSELECT = 231,
- OP_SELECT = 232,
- OP_GETC = 233,
- OP_READ = 234,
- OP_ENTERWRITE = 235,
- OP_LEAVEWRITE = 236,
- OP_PRTF = 237,
- OP_PRINT = 238,
- OP_SAY = 239,
- OP_SYSOPEN = 240,
- OP_SYSSEEK = 241,
- OP_SYSREAD = 242,
- OP_SYSWRITE = 243,
- OP_EOF = 244,
- OP_TELL = 245,
- OP_SEEK = 246,
- OP_TRUNCATE = 247,
- OP_FCNTL = 248,
- OP_IOCTL = 249,
- OP_FLOCK = 250,
- OP_SEND = 251,
- OP_RECV = 252,
- OP_SOCKET = 253,
- OP_SOCKPAIR = 254,
- OP_BIND = 255,
- OP_CONNECT = 256,
- OP_LISTEN = 257,
- OP_ACCEPT = 258,
- OP_SHUTDOWN = 259,
- OP_GSOCKOPT = 260,
- OP_SSOCKOPT = 261,
- OP_GETSOCKNAME = 262,
- OP_GETPEERNAME = 263,
- OP_LSTAT = 264,
- OP_STAT = 265,
- OP_FTRREAD = 266,
- OP_FTRWRITE = 267,
- OP_FTREXEC = 268,
- OP_FTEREAD = 269,
- OP_FTEWRITE = 270,
- OP_FTEEXEC = 271,
- OP_FTIS = 272,
- OP_FTSIZE = 273,
- OP_FTMTIME = 274,
- OP_FTATIME = 275,
- OP_FTCTIME = 276,
- OP_FTROWNED = 277,
- OP_FTEOWNED = 278,
- OP_FTZERO = 279,
- OP_FTSOCK = 280,
- OP_FTCHR = 281,
- OP_FTBLK = 282,
- OP_FTFILE = 283,
- OP_FTDIR = 284,
- OP_FTPIPE = 285,
- OP_FTSUID = 286,
- OP_FTSGID = 287,
- OP_FTSVTX = 288,
- OP_FTLINK = 289,
- OP_FTTTY = 290,
- OP_FTTEXT = 291,
- OP_FTBINARY = 292,
- OP_CHDIR = 293,
- OP_CHOWN = 294,
- OP_CHROOT = 295,
- OP_UNLINK = 296,
- OP_CHMOD = 297,
- OP_UTIME = 298,
- OP_RENAME = 299,
- OP_LINK = 300,
- OP_SYMLINK = 301,
- OP_READLINK = 302,
- OP_MKDIR = 303,
- OP_RMDIR = 304,
- OP_OPEN_DIR = 305,
- OP_READDIR = 306,
- OP_TELLDIR = 307,
- OP_SEEKDIR = 308,
- OP_REWINDDIR = 309,
- OP_CLOSEDIR = 310,
- OP_FORK = 311,
- OP_WAIT = 312,
- OP_WAITPID = 313,
- OP_SYSTEM = 314,
- OP_EXEC = 315,
- OP_KILL = 316,
- OP_GETPPID = 317,
- OP_GETPGRP = 318,
- OP_SETPGRP = 319,
- OP_GETPRIORITY = 320,
- OP_SETPRIORITY = 321,
- OP_TIME = 322,
- OP_TMS = 323,
- OP_LOCALTIME = 324,
- OP_GMTIME = 325,
- OP_ALARM = 326,
- OP_SLEEP = 327,
- OP_SHMGET = 328,
- OP_SHMCTL = 329,
- OP_SHMREAD = 330,
- OP_SHMWRITE = 331,
- OP_MSGGET = 332,
- OP_MSGCTL = 333,
- OP_MSGSND = 334,
- OP_MSGRCV = 335,
- OP_SEMOP = 336,
- OP_SEMGET = 337,
- OP_SEMCTL = 338,
- OP_REQUIRE = 339,
- OP_DOFILE = 340,
- OP_HINTSEVAL = 341,
- OP_ENTEREVAL = 342,
- OP_LEAVEEVAL = 343,
- OP_ENTERTRY = 344,
- OP_LEAVETRY = 345,
- OP_GHBYNAME = 346,
- OP_GHBYADDR = 347,
- OP_GHOSTENT = 348,
- OP_GNBYNAME = 349,
- OP_GNBYADDR = 350,
- OP_GNETENT = 351,
- OP_GPBYNAME = 352,
- OP_GPBYNUMBER = 353,
- OP_GPROTOENT = 354,
- OP_GSBYNAME = 355,
- OP_GSBYPORT = 356,
- OP_GSERVENT = 357,
- OP_SHOSTENT = 358,
- OP_SNETENT = 359,
- OP_SPROTOENT = 360,
- OP_SSERVENT = 361,
- OP_EHOSTENT = 362,
- OP_ENETENT = 363,
- OP_EPROTOENT = 364,
- OP_ESERVENT = 365,
- OP_GPWNAM = 366,
- OP_GPWUID = 367,
- OP_GPWENT = 368,
- OP_SPWENT = 369,
- OP_EPWENT = 370,
- OP_GGRNAM = 371,
- OP_GGRGID = 372,
- OP_GGRENT = 373,
- OP_SGRENT = 374,
- OP_EGRENT = 375,
- OP_GETLOGIN = 376,
- OP_SYSCALL = 377,
- OP_LOCK = 378,
- OP_ONCE = 379,
- OP_CUSTOM = 380,
- OP_COREARGS = 381,
- OP_AVHVSWITCH = 382,
- OP_RUNCV = 383,
- OP_FC = 384,
- OP_PADCV = 385,
- OP_INTROCV = 386,
- OP_CLONECV = 387,
- OP_PADRANGE = 388,
- OP_REFASSIGN = 389,
- OP_LVREF = 390,
- OP_LVREFSLICE = 391,
- OP_LVAVREF = 392,
- OP_ANONCONST = 393,
+ OP_ARGCHECK = 188,
+ OP_ARGELEM = 189,
+ OP_ARGDEFELEM = 190,
+ OP_CALLER = 191,
+ OP_WARN = 192,
+ OP_DIE = 193,
+ OP_RESET = 194,
+ OP_LINESEQ = 195,
+ OP_NEXTSTATE = 196,
+ OP_DBSTATE = 197,
+ OP_UNSTACK = 198,
+ OP_ENTER = 199,
+ OP_LEAVE = 200,
+ OP_SCOPE = 201,
+ OP_ENTERITER = 202,
+ OP_ITER = 203,
+ OP_ENTERLOOP = 204,
+ OP_LEAVELOOP = 205,
+ OP_RETURN = 206,
+ OP_LAST = 207,
+ OP_NEXT = 208,
+ OP_REDO = 209,
+ OP_DUMP = 210,
+ OP_GOTO = 211,
+ OP_EXIT = 212,
+ OP_METHOD_NAMED = 213,
+ OP_METHOD_SUPER = 214,
+ OP_METHOD_REDIR = 215,
+ OP_METHOD_REDIR_SUPER = 216,
+ OP_ENTERGIVEN = 217,
+ OP_LEAVEGIVEN = 218,
+ OP_ENTERWHEN = 219,
+ OP_LEAVEWHEN = 220,
+ OP_BREAK = 221,
+ OP_CONTINUE = 222,
+ OP_OPEN = 223,
+ OP_CLOSE = 224,
+ OP_PIPE_OP = 225,
+ OP_FILENO = 226,
+ OP_UMASK = 227,
+ OP_BINMODE = 228,
+ OP_TIE = 229,
+ OP_UNTIE = 230,
+ OP_TIED = 231,
+ OP_DBMOPEN = 232,
+ OP_DBMCLOSE = 233,
+ OP_SSELECT = 234,
+ OP_SELECT = 235,
+ OP_GETC = 236,
+ OP_READ = 237,
+ OP_ENTERWRITE = 238,
+ OP_LEAVEWRITE = 239,
+ OP_PRTF = 240,
+ OP_PRINT = 241,
+ OP_SAY = 242,
+ OP_SYSOPEN = 243,
+ OP_SYSSEEK = 244,
+ OP_SYSREAD = 245,
+ OP_SYSWRITE = 246,
+ OP_EOF = 247,
+ OP_TELL = 248,
+ OP_SEEK = 249,
+ OP_TRUNCATE = 250,
+ OP_FCNTL = 251,
+ OP_IOCTL = 252,
+ OP_FLOCK = 253,
+ OP_SEND = 254,
+ OP_RECV = 255,
+ OP_SOCKET = 256,
+ OP_SOCKPAIR = 257,
+ OP_BIND = 258,
+ OP_CONNECT = 259,
+ OP_LISTEN = 260,
+ OP_ACCEPT = 261,
+ OP_SHUTDOWN = 262,
+ OP_GSOCKOPT = 263,
+ OP_SSOCKOPT = 264,
+ OP_GETSOCKNAME = 265,
+ OP_GETPEERNAME = 266,
+ OP_LSTAT = 267,
+ OP_STAT = 268,
+ OP_FTRREAD = 269,
+ OP_FTRWRITE = 270,
+ OP_FTREXEC = 271,
+ OP_FTEREAD = 272,
+ OP_FTEWRITE = 273,
+ OP_FTEEXEC = 274,
+ OP_FTIS = 275,
+ OP_FTSIZE = 276,
+ OP_FTMTIME = 277,
+ OP_FTATIME = 278,
+ OP_FTCTIME = 279,
+ OP_FTROWNED = 280,
+ OP_FTEOWNED = 281,
+ OP_FTZERO = 282,
+ OP_FTSOCK = 283,
+ OP_FTCHR = 284,
+ OP_FTBLK = 285,
+ OP_FTFILE = 286,
+ OP_FTDIR = 287,
+ OP_FTPIPE = 288,
+ OP_FTSUID = 289,
+ OP_FTSGID = 290,
+ OP_FTSVTX = 291,
+ OP_FTLINK = 292,
+ OP_FTTTY = 293,
+ OP_FTTEXT = 294,
+ OP_FTBINARY = 295,
+ OP_CHDIR = 296,
+ OP_CHOWN = 297,
+ OP_CHROOT = 298,
+ OP_UNLINK = 299,
+ OP_CHMOD = 300,
+ OP_UTIME = 301,
+ OP_RENAME = 302,
+ OP_LINK = 303,
+ OP_SYMLINK = 304,
+ OP_READLINK = 305,
+ OP_MKDIR = 306,
+ OP_RMDIR = 307,
+ OP_OPEN_DIR = 308,
+ OP_READDIR = 309,
+ OP_TELLDIR = 310,
+ OP_SEEKDIR = 311,
+ OP_REWINDDIR = 312,
+ OP_CLOSEDIR = 313,
+ OP_FORK = 314,
+ OP_WAIT = 315,
+ OP_WAITPID = 316,
+ OP_SYSTEM = 317,
+ OP_EXEC = 318,
+ OP_KILL = 319,
+ OP_GETPPID = 320,
+ OP_GETPGRP = 321,
+ OP_SETPGRP = 322,
+ OP_GETPRIORITY = 323,
+ OP_SETPRIORITY = 324,
+ OP_TIME = 325,
+ OP_TMS = 326,
+ OP_LOCALTIME = 327,
+ OP_GMTIME = 328,
+ OP_ALARM = 329,
+ OP_SLEEP = 330,
+ OP_SHMGET = 331,
+ OP_SHMCTL = 332,
+ OP_SHMREAD = 333,
+ OP_SHMWRITE = 334,
+ OP_MSGGET = 335,
+ OP_MSGCTL = 336,
+ OP_MSGSND = 337,
+ OP_MSGRCV = 338,
+ OP_SEMOP = 339,
+ OP_SEMGET = 340,
+ OP_SEMCTL = 341,
+ OP_REQUIRE = 342,
+ OP_DOFILE = 343,
+ OP_HINTSEVAL = 344,
+ OP_ENTEREVAL = 345,
+ OP_LEAVEEVAL = 346,
+ OP_ENTERTRY = 347,
+ OP_LEAVETRY = 348,
+ OP_GHBYNAME = 349,
+ OP_GHBYADDR = 350,
+ OP_GHOSTENT = 351,
+ OP_GNBYNAME = 352,
+ OP_GNBYADDR = 353,
+ OP_GNETENT = 354,
+ OP_GPBYNAME = 355,
+ OP_GPBYNUMBER = 356,
+ OP_GPROTOENT = 357,
+ OP_GSBYNAME = 358,
+ OP_GSBYPORT = 359,
+ OP_GSERVENT = 360,
+ OP_SHOSTENT = 361,
+ OP_SNETENT = 362,
+ OP_SPROTOENT = 363,
+ OP_SSERVENT = 364,
+ OP_EHOSTENT = 365,
+ OP_ENETENT = 366,
+ OP_EPROTOENT = 367,
+ OP_ESERVENT = 368,
+ OP_GPWNAM = 369,
+ OP_GPWUID = 370,
+ OP_GPWENT = 371,
+ OP_SPWENT = 372,
+ OP_EPWENT = 373,
+ OP_GGRNAM = 374,
+ OP_GGRGID = 375,
+ OP_GGRENT = 376,
+ OP_SGRENT = 377,
+ OP_EGRENT = 378,
+ OP_GETLOGIN = 379,
+ OP_SYSCALL = 380,
+ OP_LOCK = 381,
+ OP_ONCE = 382,
+ OP_CUSTOM = 383,
+ OP_COREARGS = 384,
+ OP_AVHVSWITCH = 385,
+ OP_RUNCV = 386,
+ OP_FC = 387,
+ OP_PADCV = 388,
+ OP_INTROCV = 389,
+ OP_CLONECV = 390,
+ OP_PADRANGE = 391,
+ OP_REFASSIGN = 392,
+ OP_LVREF = 393,
+ OP_LVREFSLICE = 394,
+ OP_LVAVREF = 395,
+ OP_ANONCONST = 396,
OP_max
} opcode;
-#define MAXO 394
+#define MAXO 397
#define OP_FREED MAXO
/* the OP_IS_* macros are optimized to a simple range check because
diff --git a/perly.act b/perly.act
index 020b742db2..07e5fc29a4 100644
--- a/perly.act
+++ b/perly.act
@@ -798,32 +798,28 @@ case 2:
case 96:
#line 644 "perly.y" /* yacc.c:1646 */
- {
- (yyval.opval) = (ps[0].val.opval);
- PL_parser->in_my = 0;
- }
+ { (yyval.opval) = (ps[0].val.opval); }
break;
case 97:
-#line 652 "perly.y" /* yacc.c:1646 */
+#line 649 "perly.y" /* yacc.c:1646 */
{ (yyval.ival) = '@'; }
break;
case 98:
-#line 654 "perly.y" /* yacc.c:1646 */
+#line 651 "perly.y" /* yacc.c:1646 */
{ (yyval.ival) = '%'; }
break;
case 99:
-#line 658 "perly.y" /* yacc.c:1646 */
+#line 655 "perly.y" /* yacc.c:1646 */
{
- I32 sigil = (ps[-2].val.ival);
- OP *var = (ps[-1].val.opval);
+ I32 sigil = (ps[-2].val.ival);
+ OP *var = (ps[-1].val.opval);
OP *defexpr = (ps[0].val.opval);
- int type = (sigil == '@' ? OP_PADAV : OP_PADHV);
if (PL_parser->sig_slurpy)
yyerror("Multiple slurpy parameters not allowed");
@@ -833,154 +829,113 @@ case 2:
yyerror("a slurpy parameter may not have "
"a default value");
- if (var) {
- OP *slice;
-
- var->op_type = type;
- var->op_ppaddr = PL_ppaddr[type];
- var->op_flags = (OPf_WANT_LIST | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
-
- slice = PL_parser->sig_elems
- ? op_prepend_elem(OP_ASLICE,
- newOP(OP_PUSHMARK, 0),
- newLISTOP(OP_ASLICE, 0,
- list(newRANGE(0,
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)),
- newUNOP(OP_AV2ARYLEN, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_AV2ARYLEN)))),
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_ASLICE)))
- : newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv));
- (yyval.opval) = newSTATEOP(0, NULL,
- newASSIGNOP(OPf_STACKED, var, 0, slice));
- }
- else
- (yyval.opval) = (OP*)NULL;
+ (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
break;
case 100:
-#line 705 "perly.y" /* yacc.c:1646 */
+#line 674 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 101:
-#line 707 "perly.y" /* yacc.c:1646 */
+#line 676 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP(OP_NULL, 0); }
break;
case 102:
-#line 709 "perly.y" /* yacc.c:1646 */
+#line 678 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 103:
-#line 715 "perly.y" /* yacc.c:1646 */
+#line 684 "perly.y" /* yacc.c:1646 */
{
OP *var = (ps[-1].val.opval);
OP *defexpr = (ps[0].val.opval);
- OP *argn = NULL;
- OP *expr = NULL;
if (PL_parser->sig_slurpy)
yyerror("Slurpy parameter not last");
PL_parser->sig_elems++;
- if (var) {
- var->op_type = OP_PADSV;
- var->op_ppaddr = PL_ppaddr[OP_PADSV];
- var->op_flags = (OPf_WANT_SCALAR | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
- }
-
- /* $_[N] */
- argn = newBINOP(OP_AELEM, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_RV2AV),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems - 1)));
-
if (defexpr) {
PL_parser->sig_optelems++;
- /* is it '$var=undef', '$=' ? */
- if ( ( defexpr->op_type == OP_NULL
- || defexpr->op_type == OP_UNDEF)
+
+ if ( defexpr->op_type == OP_NULL
&& !(defexpr->op_flags & OPf_KIDS))
{
- if (var) {
- /* '$=' is legal, '$var=' isn't */
- if (defexpr->op_type == OP_NULL)
- yyerror("Optional parameter "
- "lacks default expression");
- else
- expr = argn;
- }
+ /* handle '$=' special case */
+ if (var)
+ yyerror("Optional parameter "
+ "lacks default expression");
op_free(defexpr);
}
- else {
- /* @_ >= N */
- OP *ge_op =
- newBINOP(OP_GE, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)));
-
- expr = var
- ? newCONDOP(0, ge_op, argn, defexpr)
- : newLOGOP(OP_OR, 0, ge_op, defexpr);
+ else {
+ /* a normal '=default' expression */
+ OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+ defexpr,
+ LINKLIST(defexpr));
+ /* re-purpose op_targ to hold @_ index */
+ defop->op_targ = PL_parser->sig_elems - 1;
+
+ if (var) {
+ var->op_flags |= OPf_STACKED;
+ (void)op_sibling_splice(var,
+ NULL, 0, defop);
+ scalar(defop);
+ }
+ else
+ var = newUNOP(OP_NULL, 0, defop);
+
+ LINKLIST(var);
+ /* NB: normally the first child of a
+ * logop is executed before the logop,
+ * and it pushes a boolean result
+ * ready for the logop. For ARGDEFELEM,
+ * the op itself does the boolean
+ * calculation, so set the first op to
+ * it instead.
+ */
+ var->op_next = defop;
+ defexpr->op_next = var;
}
}
else {
if (PL_parser->sig_optelems)
yyerror("Mandatory parameter "
"follows optional parameter");
- expr = argn;
}
- if (var)
- expr = newASSIGNOP(OPf_STACKED, var, 0, expr);
- if (expr)
- (yyval.opval) = op_prepend_elem(OP_LINESEQ,
- newSTATEOP(0, NULL, NULL),
- expr);
- else
- (yyval.opval) = (OP*)NULL;
+ (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
break;
case 104:
-#line 793 "perly.y" /* yacc.c:1646 */
+#line 748 "perly.y" /* yacc.c:1646 */
{ parser->expect = XSIGVAR; (yyval.opval) = (ps[0].val.opval); }
break;
case 105:
-#line 795 "perly.y" /* yacc.c:1646 */
+#line 750 "perly.y" /* yacc.c:1646 */
{ parser->expect = XSIGVAR; (yyval.opval) = (ps[0].val.opval); }
break;
case 106:
-#line 801 "perly.y" /* yacc.c:1646 */
+#line 756 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-1].val.opval); }
break;
case 107:
-#line 803 "perly.y" /* yacc.c:1646 */
+#line 758 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval));
}
@@ -988,25 +943,25 @@ case 2:
break;
case 108:
-#line 807 "perly.y" /* yacc.c:1646 */
+#line 762 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 109:
-#line 812 "perly.y" /* yacc.c:1646 */
+#line 767 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 110:
-#line 814 "perly.y" /* yacc.c:1646 */
+#line 769 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 111:
-#line 818 "perly.y" /* yacc.c:1646 */
+#line 773 "perly.y" /* yacc.c:1646 */
{
ENTER;
SAVEINT(PL_parser->sig_elems);
@@ -1021,11 +976,11 @@ case 2:
break;
case 112:
-#line 830 "perly.y" /* yacc.c:1646 */
+#line 785 "perly.y" /* yacc.c:1646 */
{
- OP *sigops = (ps[-1].val.opval);
- int min_arity =
- PL_parser->sig_elems - PL_parser->sig_optelems;
+ OP *sigops = (ps[-1].val.opval);
+ UNOP_AUX_item *aux;
+ OP *check;
assert(FEATURE_SIGNATURES_IS_ENABLED);
@@ -1034,52 +989,21 @@ case 2:
packWARN(WARN_EXPERIMENTAL__SIGNATURES),
"The signatures feature is experimental");
- /* handle odd/even for %foo */
- if (PL_parser->sig_slurpy == '%') {
- OP *chkop =
- newLOGOP(
- (PL_parser->sig_elems & 1)
- ? OP_OR : OP_AND,
- 0,
- newBINOP(OP_BIT_AND, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0, newSViv(1))),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- newSVpvs("Odd name/value argument for subroutine at %s line %d.\n")),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0))))));
- if (PL_parser->sig_optelems)
- chkop = newLOGOP(OP_AND, 0,
- newBINOP(OP_GT, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems))),
- chkop);
- sigops = op_prepend_elem(OP_LINESEQ,
- chkop, sigops);
-
- }
- if (min_arity)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_ min_arity,
- FALSE),
- sigops);
- if (!PL_parser->sig_slurpy)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_
- PL_parser->sig_elems, TRUE),
- sigops);
-
- (yyval.opval) = op_append_elem(OP_LINESEQ, sigops,
- newSTATEOP(0, NULL, NULL));
+ aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+ sizeof(UNOP_AUX_item) * 3);
+ aux[0].uv = PL_parser->sig_elems;
+ aux[1].uv = PL_parser->sig_optelems;
+ aux[2].iv = PL_parser->sig_slurpy;
+ check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+ sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+ sigops = op_prepend_elem(OP_LINESEQ,
+ newSTATEOP(0, NULL, NULL),
+ sigops);
+ /* a nextstate at the end handles context
+ * correctly for an empty sub body */
+ (yyval.opval) = op_append_elem(OP_LINESEQ,
+ sigops,
+ newSTATEOP(0, NULL, NULL));
parser->expect = XATTRBLOCK;
LEAVE;
@@ -1088,37 +1012,37 @@ case 2:
break;
case 114:
-#line 898 "perly.y" /* yacc.c:1646 */
+#line 822 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 115:
-#line 903 "perly.y" /* yacc.c:1646 */
+#line 827 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 116:
-#line 905 "perly.y" /* yacc.c:1646 */
+#line 829 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 117:
-#line 907 "perly.y" /* yacc.c:1646 */
+#line 831 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 119:
-#line 913 "perly.y" /* yacc.c:1646 */
+#line 837 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-1].val.opval); }
break;
case 120:
-#line 915 "perly.y" /* yacc.c:1646 */
+#line 839 "perly.y" /* yacc.c:1646 */
{
OP* term = (ps[0].val.opval);
(yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term);
@@ -1127,7 +1051,7 @@ case 2:
break;
case 122:
-#line 924 "perly.y" /* yacc.c:1646 */
+#line 848 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED,
op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) );
}
@@ -1135,7 +1059,7 @@ case 2:
break;
case 123:
-#line 928 "perly.y" /* yacc.c:1646 */
+#line 852 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED,
op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) );
}
@@ -1143,7 +1067,7 @@ case 2:
break;
case 124:
-#line 932 "perly.y" /* yacc.c:1646 */
+#line 856 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)),
@@ -1153,7 +1077,7 @@ case 2:
break;
case 125:
-#line 938 "perly.y" /* yacc.c:1646 */
+#line 862 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, scalar((ps[-2].val.opval)),
newMETHOP(OP_METHOD, 0, (ps[0].val.opval))));
@@ -1162,7 +1086,7 @@ case 2:
break;
case 126:
-#line 943 "perly.y" /* yacc.c:1646 */
+#line 867 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)),
@@ -1172,7 +1096,7 @@ case 2:
break;
case 127:
-#line 949 "perly.y" /* yacc.c:1646 */
+#line 873 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)),
@@ -1182,26 +1106,26 @@ case 2:
break;
case 128:
-#line 955 "perly.y" /* yacc.c:1646 */
+#line 879 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 129:
-#line 957 "perly.y" /* yacc.c:1646 */
+#line 881 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
break;
case 130:
-#line 959 "perly.y" /* yacc.c:1646 */
+#line 883 "perly.y" /* yacc.c:1646 */
{ SvREFCNT_inc_simple_void(PL_compcv);
(yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, (OP*)NULL, (ps[0].val.opval)); }
break;
case 131:
-#line 962 "perly.y" /* yacc.c:1646 */
+#line 886 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval)));
@@ -1210,20 +1134,20 @@ case 2:
break;
case 134:
-#line 977 "perly.y" /* yacc.c:1646 */
+#line 901 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); }
break;
case 135:
-#line 979 "perly.y" /* yacc.c:1646 */
+#line 903 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval)));
}
break;
case 136:
-#line 982 "perly.y" /* yacc.c:1646 */
+#line 906 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0,
ref(newAVREF((ps[-4].val.opval)),OP_RV2AV),
scalar((ps[-1].val.opval)));
@@ -1232,7 +1156,7 @@ case 2:
break;
case 137:
-#line 987 "perly.y" /* yacc.c:1646 */
+#line 911 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0,
ref(newAVREF((ps[-3].val.opval)),OP_RV2AV),
scalar((ps[-1].val.opval)));
@@ -1241,14 +1165,14 @@ case 2:
break;
case 138:
-#line 992 "perly.y" /* yacc.c:1646 */
+#line 916 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval)));
}
break;
case 139:
-#line 995 "perly.y" /* yacc.c:1646 */
+#line 919 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0,
ref(newHVREF((ps[-5].val.opval)),OP_RV2HV),
jmaybe((ps[-2].val.opval))); }
@@ -1256,7 +1180,7 @@ case 2:
break;
case 140:
-#line 999 "perly.y" /* yacc.c:1646 */
+#line 923 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0,
ref(newHVREF((ps[-4].val.opval)),OP_RV2HV),
jmaybe((ps[-2].val.opval))); }
@@ -1264,14 +1188,14 @@ case 2:
break;
case 141:
-#line 1003 "perly.y" /* yacc.c:1646 */
+#line 927 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar((ps[-3].val.opval)))); }
break;
case 142:
-#line 1006 "perly.y" /* yacc.c:1646 */
+#line 930 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval),
newCVREF(0, scalar((ps[-4].val.opval))))); }
@@ -1279,7 +1203,7 @@ case 2:
break;
case 143:
-#line 1011 "perly.y" /* yacc.c:1646 */
+#line 935 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval),
newCVREF(0, scalar((ps[-3].val.opval))))); }
@@ -1287,44 +1211,44 @@ case 2:
break;
case 144:
-#line 1015 "perly.y" /* yacc.c:1646 */
+#line 939 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar((ps[-2].val.opval)))); }
break;
case 145:
-#line 1018 "perly.y" /* yacc.c:1646 */
+#line 942 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); }
break;
case 146:
-#line 1020 "perly.y" /* yacc.c:1646 */
+#line 944 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); }
break;
case 147:
-#line 1022 "perly.y" /* yacc.c:1646 */
+#line 946 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (OP*)NULL); }
break;
case 148:
-#line 1027 "perly.y" /* yacc.c:1646 */
+#line 951 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); }
break;
case 149:
-#line 1029 "perly.y" /* yacc.c:1646 */
+#line 953 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 150:
-#line 1031 "perly.y" /* yacc.c:1646 */
+#line 955 "perly.y" /* yacc.c:1646 */
{ if ((ps[-1].val.ival) != OP_REPEAT)
scalar((ps[-2].val.opval));
(yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval)));
@@ -1333,111 +1257,111 @@ case 2:
break;
case 151:
-#line 1036 "perly.y" /* yacc.c:1646 */
+#line 960 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 152:
-#line 1038 "perly.y" /* yacc.c:1646 */
+#line 962 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 153:
-#line 1040 "perly.y" /* yacc.c:1646 */
+#line 964 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 154:
-#line 1042 "perly.y" /* yacc.c:1646 */
+#line 966 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 155:
-#line 1044 "perly.y" /* yacc.c:1646 */
+#line 968 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 156:
-#line 1046 "perly.y" /* yacc.c:1646 */
+#line 970 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 157:
-#line 1048 "perly.y" /* yacc.c:1646 */
+#line 972 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 158:
-#line 1050 "perly.y" /* yacc.c:1646 */
+#line 974 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 159:
-#line 1052 "perly.y" /* yacc.c:1646 */
+#line 976 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 160:
-#line 1054 "perly.y" /* yacc.c:1646 */
+#line 978 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 161:
-#line 1056 "perly.y" /* yacc.c:1646 */
+#line 980 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 162:
-#line 1061 "perly.y" /* yacc.c:1646 */
+#line 985 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); }
break;
case 163:
-#line 1063 "perly.y" /* yacc.c:1646 */
+#line 987 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 164:
-#line 1066 "perly.y" /* yacc.c:1646 */
+#line 990 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
break;
case 165:
-#line 1068 "perly.y" /* yacc.c:1646 */
+#line 992 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); }
break;
case 166:
-#line 1070 "perly.y" /* yacc.c:1646 */
+#line 994 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_POSTINC, 0,
op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); }
break;
case 167:
-#line 1073 "perly.y" /* yacc.c:1646 */
+#line 997 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_POSTDEC, 0,
op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));}
break;
case 168:
-#line 1076 "perly.y" /* yacc.c:1646 */
+#line 1000 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_JOIN, 0,
op_append_elem(
OP_LIST,
@@ -1452,52 +1376,52 @@ case 2:
break;
case 169:
-#line 1087 "perly.y" /* yacc.c:1646 */
+#line 1011 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_PREINC, 0,
op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); }
break;
case 170:
-#line 1090 "perly.y" /* yacc.c:1646 */
+#line 1014 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_PREDEC, 0,
op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); }
break;
case 171:
-#line 1097 "perly.y" /* yacc.c:1646 */
+#line 1021 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONLIST((ps[-1].val.opval)); }
break;
case 172:
-#line 1099 "perly.y" /* yacc.c:1646 */
+#line 1023 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONLIST((OP*)NULL);}
break;
case 173:
-#line 1101 "perly.y" /* yacc.c:1646 */
+#line 1025 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONHASH((ps[-2].val.opval)); }
break;
case 174:
-#line 1103 "perly.y" /* yacc.c:1646 */
+#line 1027 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONHASH((OP*)NULL); }
break;
case 175:
-#line 1105 "perly.y" /* yacc.c:1646 */
+#line 1029 "perly.y" /* yacc.c:1646 */
{ SvREFCNT_inc_simple_void(PL_compcv);
(yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); }
break;
case 176:
-#line 1108 "perly.y" /* yacc.c:1646 */
+#line 1032 "perly.y" /* yacc.c:1646 */
{
OP *body;
if (parser->copline > (line_t)(ps[-2].val.ival))
@@ -1511,103 +1435,103 @@ case 2:
break;
case 177:
-#line 1122 "perly.y" /* yacc.c:1646 */
+#line 1046 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));}
break;
case 178:
-#line 1124 "perly.y" /* yacc.c:1646 */
+#line 1048 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));}
break;
case 183:
-#line 1132 "perly.y" /* yacc.c:1646 */
+#line 1056 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 184:
-#line 1134 "perly.y" /* yacc.c:1646 */
+#line 1058 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); }
break;
case 185:
-#line 1136 "perly.y" /* yacc.c:1646 */
+#line 1060 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); }
break;
case 186:
-#line 1138 "perly.y" /* yacc.c:1646 */
+#line 1062 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 187:
-#line 1140 "perly.y" /* yacc.c:1646 */
+#line 1064 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = localize((ps[0].val.opval),0); }
break;
case 188:
-#line 1142 "perly.y" /* yacc.c:1646 */
+#line 1066 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens((ps[-1].val.opval)); }
break;
case 189:
-#line 1144 "perly.y" /* yacc.c:1646 */
+#line 1068 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 190:
-#line 1146 "perly.y" /* yacc.c:1646 */
+#line 1070 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens(newNULLLIST()); }
break;
case 191:
-#line 1148 "perly.y" /* yacc.c:1646 */
+#line 1072 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 192:
-#line 1150 "perly.y" /* yacc.c:1646 */
+#line 1074 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 193:
-#line 1152 "perly.y" /* yacc.c:1646 */
+#line 1076 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 194:
-#line 1154 "perly.y" /* yacc.c:1646 */
+#line 1078 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 195:
-#line 1156 "perly.y" /* yacc.c:1646 */
+#line 1080 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));}
break;
case 196:
-#line 1158 "perly.y" /* yacc.c:1646 */
+#line 1082 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 197:
-#line 1160 "perly.y" /* yacc.c:1646 */
+#line 1084 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
@@ -1621,7 +1545,7 @@ case 2:
break;
case 198:
-#line 1170 "perly.y" /* yacc.c:1646 */
+#line 1094 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_KVASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVASLICE, 0,
@@ -1635,7 +1559,7 @@ case 2:
break;
case 199:
-#line 1180 "perly.y" /* yacc.c:1646 */
+#line 1104 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
@@ -1649,7 +1573,7 @@ case 2:
break;
case 200:
-#line 1190 "perly.y" /* yacc.c:1646 */
+#line 1114 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_KVHSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVHSLICE, 0,
@@ -1663,26 +1587,26 @@ case 2:
break;
case 201:
-#line 1200 "perly.y" /* yacc.c:1646 */
+#line 1124 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 202:
-#line 1202 "perly.y" /* yacc.c:1646 */
+#line 1126 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); }
break;
case 203:
-#line 1204 "perly.y" /* yacc.c:1646 */
+#line 1128 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval)));
}
break;
case 204:
-#line 1207 "perly.y" /* yacc.c:1646 */
+#line 1131 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval))));
@@ -1691,7 +1615,7 @@ case 2:
break;
case 205:
-#line 1212 "perly.y" /* yacc.c:1646 */
+#line 1136 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval))));
}
@@ -1699,130 +1623,130 @@ case 2:
break;
case 206:
-#line 1216 "perly.y" /* yacc.c:1646 */
+#line 1140 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSVREF((ps[-3].val.opval)); }
break;
case 207:
-#line 1218 "perly.y" /* yacc.c:1646 */
+#line 1142 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-3].val.opval)); }
break;
case 208:
-#line 1220 "perly.y" /* yacc.c:1646 */
+#line 1144 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[-3].val.opval)); }
break;
case 209:
-#line 1222 "perly.y" /* yacc.c:1646 */
+#line 1146 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, 0,
scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); }
break;
case 210:
-#line 1225 "perly.y" /* yacc.c:1646 */
+#line 1149 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); }
break;
case 211:
-#line 1227 "perly.y" /* yacc.c:1646 */
+#line 1151 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL);
PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 212:
-#line 1230 "perly.y" /* yacc.c:1646 */
+#line 1154 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); }
break;
case 213:
-#line 1232 "perly.y" /* yacc.c:1646 */
+#line 1156 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
break;
case 214:
-#line 1234 "perly.y" /* yacc.c:1646 */
+#line 1158 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), 0); }
break;
case 215:
-#line 1236 "perly.y" /* yacc.c:1646 */
+#line 1160 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 216:
-#line 1238 "perly.y" /* yacc.c:1646 */
+#line 1162 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 217:
-#line 1240 "perly.y" /* yacc.c:1646 */
+#line 1164 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); }
break;
case 218:
-#line 1242 "perly.y" /* yacc.c:1646 */
+#line 1166 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); }
break;
case 219:
-#line 1244 "perly.y" /* yacc.c:1646 */
+#line 1168 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
break;
case 220:
-#line 1246 "perly.y" /* yacc.c:1646 */
+#line 1170 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); }
break;
case 221:
-#line 1249 "perly.y" /* yacc.c:1646 */
+#line 1173 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), 0); }
break;
case 222:
-#line 1251 "perly.y" /* yacc.c:1646 */
+#line 1175 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[-2].val.ival), 0);}
break;
case 223:
-#line 1253 "perly.y" /* yacc.c:1646 */
+#line 1177 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 224:
-#line 1255 "perly.y" /* yacc.c:1646 */
+#line 1179 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-2].val.opval); }
break;
case 225:
-#line 1257 "perly.y" /* yacc.c:1646 */
+#line 1181 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
break;
case 226:
-#line 1259 "perly.y" /* yacc.c:1646 */
+#line 1183 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = ((ps[-2].val.ival) == OP_NOT)
? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0)))
: newOP((ps[-2].val.ival), OPf_SPECIAL); }
@@ -1830,13 +1754,13 @@ case 2:
break;
case 227:
-#line 1263 "perly.y" /* yacc.c:1646 */
+#line 1187 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
break;
case 228:
-#line 1265 "perly.y" /* yacc.c:1646 */
+#line 1189 "perly.y" /* yacc.c:1646 */
{
if ( (ps[0].val.opval)->op_type != OP_TRANS
&& (ps[0].val.opval)->op_type != OP_TRANSR
@@ -1851,13 +1775,13 @@ case 2:
break;
case 229:
-#line 1276 "perly.y" /* yacc.c:1646 */
+#line 1200 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); }
break;
case 232:
-#line 1280 "perly.y" /* yacc.c:1646 */
+#line 1204 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
@@ -1866,109 +1790,109 @@ case 2:
break;
case 234:
-#line 1289 "perly.y" /* yacc.c:1646 */
+#line 1213 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); }
break;
case 235:
-#line 1291 "perly.y" /* yacc.c:1646 */
+#line 1215 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = localize((ps[0].val.opval),1); }
break;
case 236:
-#line 1293 "perly.y" /* yacc.c:1646 */
+#line 1217 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); }
break;
case 237:
-#line 1298 "perly.y" /* yacc.c:1646 */
+#line 1222 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens((ps[-1].val.opval)); }
break;
case 238:
-#line 1300 "perly.y" /* yacc.c:1646 */
+#line 1224 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens(newNULLLIST()); }
break;
case 239:
-#line 1303 "perly.y" /* yacc.c:1646 */
+#line 1227 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 240:
-#line 1305 "perly.y" /* yacc.c:1646 */
+#line 1229 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 241:
-#line 1307 "perly.y" /* yacc.c:1646 */
+#line 1231 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 242:
-#line 1312 "perly.y" /* yacc.c:1646 */
+#line 1236 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 243:
-#line 1314 "perly.y" /* yacc.c:1646 */
+#line 1238 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 244:
-#line 1318 "perly.y" /* yacc.c:1646 */
+#line 1242 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 245:
-#line 1320 "perly.y" /* yacc.c:1646 */
+#line 1244 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 246:
-#line 1324 "perly.y" /* yacc.c:1646 */
+#line 1248 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 247:
-#line 1326 "perly.y" /* yacc.c:1646 */
+#line 1250 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 248:
-#line 1332 "perly.y" /* yacc.c:1646 */
+#line 1256 "perly.y" /* yacc.c:1646 */
{ parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); }
break;
case 256:
-#line 1349 "perly.y" /* yacc.c:1646 */
+#line 1273 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); }
break;
case 257:
-#line 1353 "perly.y" /* yacc.c:1646 */
+#line 1277 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSVREF((ps[0].val.opval)); }
break;
case 258:
-#line 1357 "perly.y" /* yacc.c:1646 */
+#line 1281 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[0].val.opval));
if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
}
@@ -1976,7 +1900,7 @@ case 2:
break;
case 259:
-#line 1363 "perly.y" /* yacc.c:1646 */
+#line 1287 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[0].val.opval));
if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
}
@@ -1984,61 +1908,61 @@ case 2:
break;
case 260:
-#line 1369 "perly.y" /* yacc.c:1646 */
+#line 1293 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[0].val.opval)); }
break;
case 261:
-#line 1371 "perly.y" /* yacc.c:1646 */
+#line 1295 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-3].val.opval)); }
break;
case 262:
-#line 1375 "perly.y" /* yacc.c:1646 */
+#line 1299 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[0].val.opval)); }
break;
case 264:
-#line 1380 "perly.y" /* yacc.c:1646 */
+#line 1304 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-2].val.opval)); }
break;
case 266:
-#line 1385 "perly.y" /* yacc.c:1646 */
+#line 1309 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[-2].val.opval)); }
break;
case 268:
-#line 1390 "perly.y" /* yacc.c:1646 */
+#line 1314 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); }
break;
case 269:
-#line 1395 "perly.y" /* yacc.c:1646 */
+#line 1319 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = scalar((ps[0].val.opval)); }
break;
case 270:
-#line 1397 "perly.y" /* yacc.c:1646 */
+#line 1321 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = scalar((ps[0].val.opval)); }
break;
case 271:
-#line 1399 "perly.y" /* yacc.c:1646 */
+#line 1323 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_scope((ps[0].val.opval)); }
break;
case 272:
-#line 1402 "perly.y" /* yacc.c:1646 */
+#line 1326 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
@@ -2049,6 +1973,6 @@ case 2:
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.h b/perly.h
index 8c8c459f3c..25c69c5383 100644
--- a/perly.h
+++ b/perly.h
@@ -181,6 +181,6 @@ int yyparse (void);
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.tab b/perly.tab
index f6685b856b..997be30c97 100644
--- a/perly.tab
+++ b/perly.tab
@@ -78,25 +78,25 @@ static const yytype_uint16 yyrline[] =
510, 512, 514, 516, 518, 520, 522, 525, 531, 532,
537, 548, 549, 555, 561, 562, 567, 570, 574, 579,
583, 587, 588, 592, 598, 603, 608, 609, 614, 615,
- 620, 621, 623, 628, 630, 642, 643, 651, 653, 657,
- 705, 706, 708, 714, 792, 794, 800, 802, 806, 812,
- 813, 818, 817, 897, 898, 902, 904, 906, 908, 912,
- 914, 919, 923, 927, 931, 937, 942, 948, 954, 956,
- 959, 958, 969, 970, 974, 978, 981, 986, 991, 994,
- 998, 1002, 1005, 1010, 1014, 1017, 1019, 1021, 1026, 1028,
- 1030, 1035, 1037, 1039, 1041, 1043, 1045, 1047, 1049, 1051,
- 1053, 1055, 1060, 1062, 1065, 1067, 1069, 1072, 1075, 1086,
- 1089, 1096, 1098, 1100, 1102, 1104, 1107, 1121, 1123, 1127,
- 1128, 1129, 1130, 1131, 1133, 1135, 1137, 1139, 1141, 1143,
- 1145, 1147, 1149, 1151, 1153, 1155, 1157, 1159, 1169, 1179,
- 1189, 1199, 1201, 1203, 1206, 1211, 1215, 1217, 1219, 1221,
- 1224, 1226, 1229, 1231, 1233, 1235, 1237, 1239, 1241, 1243,
- 1245, 1248, 1250, 1252, 1254, 1256, 1258, 1262, 1265, 1264,
- 1277, 1278, 1279, 1284, 1288, 1290, 1292, 1297, 1299, 1302,
- 1304, 1306, 1311, 1313, 1318, 1319, 1324, 1325, 1331, 1335,
- 1336, 1337, 1340, 1341, 1344, 1345, 1348, 1352, 1356, 1362,
- 1368, 1370, 1374, 1378, 1379, 1383, 1384, 1388, 1389, 1394,
- 1396, 1398, 1401
+ 620, 621, 623, 628, 630, 642, 643, 648, 650, 654,
+ 674, 675, 677, 683, 747, 749, 755, 757, 761, 767,
+ 768, 773, 772, 821, 822, 826, 828, 830, 832, 836,
+ 838, 843, 847, 851, 855, 861, 866, 872, 878, 880,
+ 883, 882, 893, 894, 898, 902, 905, 910, 915, 918,
+ 922, 926, 929, 934, 938, 941, 943, 945, 950, 952,
+ 954, 959, 961, 963, 965, 967, 969, 971, 973, 975,
+ 977, 979, 984, 986, 989, 991, 993, 996, 999, 1010,
+ 1013, 1020, 1022, 1024, 1026, 1028, 1031, 1045, 1047, 1051,
+ 1052, 1053, 1054, 1055, 1057, 1059, 1061, 1063, 1065, 1067,
+ 1069, 1071, 1073, 1075, 1077, 1079, 1081, 1083, 1093, 1103,
+ 1113, 1123, 1125, 1127, 1130, 1135, 1139, 1141, 1143, 1145,
+ 1148, 1150, 1153, 1155, 1157, 1159, 1161, 1163, 1165, 1167,
+ 1169, 1172, 1174, 1176, 1178, 1180, 1182, 1186, 1189, 1188,
+ 1201, 1202, 1203, 1208, 1212, 1214, 1216, 1221, 1223, 1226,
+ 1228, 1230, 1235, 1237, 1242, 1243, 1248, 1249, 1255, 1259,
+ 1260, 1261, 1264, 1265, 1268, 1269, 1272, 1276, 1280, 1286,
+ 1292, 1294, 1298, 1302, 1303, 1307, 1308, 1312, 1313, 1318,
+ 1320, 1322, 1325
};
#endif
@@ -1109,6 +1109,6 @@ static const toketypes yy_type_tab[] =
};
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.y b/perly.y
index f28124d9f4..2f3647fc0b 100644
--- a/perly.y
+++ b/perly.y
@@ -641,10 +641,7 @@ myattrlist: COLONATTR THING
sigvarname: /* NULL */
{ $$ = (OP*)NULL; }
| PRIVATEREF
- {
- $$ = $1;
- PL_parser->in_my = 0;
- }
+ { $$ = $1; }
;
sigslurpsigil:
@@ -656,10 +653,9 @@ sigslurpsigil:
/* @, %, @foo, %foo */
sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
{
- I32 sigil = $1;
- OP *var = $2;
+ I32 sigil = $1;
+ OP *var = $2;
OP *defexpr = $3;
- int type = (sigil == '@' ? OP_PADAV : OP_PADHV);
if (PL_parser->sig_slurpy)
yyerror("Multiple slurpy parameters not allowed");
@@ -669,34 +665,7 @@ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
yyerror("a slurpy parameter may not have "
"a default value");
- if (var) {
- OP *slice;
-
- var->op_type = type;
- var->op_ppaddr = PL_ppaddr[type];
- var->op_flags = (OPf_WANT_LIST | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
-
- slice = PL_parser->sig_elems
- ? op_prepend_elem(OP_ASLICE,
- newOP(OP_PUSHMARK, 0),
- newLISTOP(OP_ASLICE, 0,
- list(newRANGE(0,
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)),
- newUNOP(OP_AV2ARYLEN, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_AV2ARYLEN)))),
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_ASLICE)))
- : newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv));
- $$ = newSTATEOP(0, NULL,
- newASSIGNOP(OPf_STACKED, var, 0, slice));
- }
- else
- $$ = (OP*)NULL;
+ $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
;
@@ -715,75 +684,61 @@ sigscalarelem:
{
OP *var = $2;
OP *defexpr = $3;
- OP *argn = NULL;
- OP *expr = NULL;
if (PL_parser->sig_slurpy)
yyerror("Slurpy parameter not last");
PL_parser->sig_elems++;
- if (var) {
- var->op_type = OP_PADSV;
- var->op_ppaddr = PL_ppaddr[OP_PADSV];
- var->op_flags = (OPf_WANT_SCALAR | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
- }
-
- /* $_[N] */
- argn = newBINOP(OP_AELEM, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_RV2AV),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems - 1)));
-
if (defexpr) {
PL_parser->sig_optelems++;
- /* is it '$var=undef', '$=' ? */
- if ( ( defexpr->op_type == OP_NULL
- || defexpr->op_type == OP_UNDEF)
+
+ if ( defexpr->op_type == OP_NULL
&& !(defexpr->op_flags & OPf_KIDS))
{
- if (var) {
- /* '$=' is legal, '$var=' isn't */
- if (defexpr->op_type == OP_NULL)
- yyerror("Optional parameter "
- "lacks default expression");
- else
- expr = argn;
- }
+ /* handle '$=' special case */
+ if (var)
+ yyerror("Optional parameter "
+ "lacks default expression");
op_free(defexpr);
}
- else {
- /* @_ >= N */
- OP *ge_op =
- newBINOP(OP_GE, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)));
-
- expr = var
- ? newCONDOP(0, ge_op, argn, defexpr)
- : newLOGOP(OP_OR, 0, ge_op, defexpr);
+ else {
+ /* a normal '=default' expression */
+ OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+ defexpr,
+ LINKLIST(defexpr));
+ /* re-purpose op_targ to hold @_ index */
+ defop->op_targ = PL_parser->sig_elems - 1;
+
+ if (var) {
+ var->op_flags |= OPf_STACKED;
+ (void)op_sibling_splice(var,
+ NULL, 0, defop);
+ scalar(defop);
+ }
+ else
+ var = newUNOP(OP_NULL, 0, defop);
+
+ LINKLIST(var);
+ /* NB: normally the first child of a
+ * logop is executed before the logop,
+ * and it pushes a boolean result
+ * ready for the logop. For ARGDEFELEM,
+ * the op itself does the boolean
+ * calculation, so set the first op to
+ * it instead.
+ */
+ var->op_next = defop;
+ defexpr->op_next = var;
}
}
else {
if (PL_parser->sig_optelems)
yyerror("Mandatory parameter "
"follows optional parameter");
- expr = argn;
}
- if (var)
- expr = newASSIGNOP(OPf_STACKED, var, 0, expr);
- if (expr)
- $$ = op_prepend_elem(OP_LINESEQ,
- newSTATEOP(0, NULL, NULL),
- expr);
- else
- $$ = (OP*)NULL;
+ $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
;
@@ -828,9 +783,9 @@ subsignature: '('
siglistornull
')'
{
- OP *sigops = $3;
- int min_arity =
- PL_parser->sig_elems - PL_parser->sig_optelems;
+ OP *sigops = $3;
+ UNOP_AUX_item *aux;
+ OP *check;
assert(FEATURE_SIGNATURES_IS_ENABLED);
@@ -839,52 +794,21 @@ subsignature: '('
packWARN(WARN_EXPERIMENTAL__SIGNATURES),
"The signatures feature is experimental");
- /* handle odd/even for %foo */
- if (PL_parser->sig_slurpy == '%') {
- OP *chkop =
- newLOGOP(
- (PL_parser->sig_elems & 1)
- ? OP_OR : OP_AND,
- 0,
- newBINOP(OP_BIT_AND, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0, newSViv(1))),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- newSVpvs("Odd name/value argument for subroutine at %s line %d.\n")),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0))))));
- if (PL_parser->sig_optelems)
- chkop = newLOGOP(OP_AND, 0,
- newBINOP(OP_GT, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems))),
- chkop);
- sigops = op_prepend_elem(OP_LINESEQ,
- chkop, sigops);
-
- }
- if (min_arity)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_ min_arity,
- FALSE),
- sigops);
- if (!PL_parser->sig_slurpy)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_
- PL_parser->sig_elems, TRUE),
- sigops);
-
- $$ = op_append_elem(OP_LINESEQ, sigops,
- newSTATEOP(0, NULL, NULL));
+ aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+ sizeof(UNOP_AUX_item) * 3);
+ aux[0].uv = PL_parser->sig_elems;
+ aux[1].uv = PL_parser->sig_optelems;
+ aux[2].iv = PL_parser->sig_slurpy;
+ check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+ sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+ sigops = op_prepend_elem(OP_LINESEQ,
+ newSTATEOP(0, NULL, NULL),
+ sigops);
+ /* a nextstate at the end handles context
+ * correctly for an empty sub body */
+ $$ = op_append_elem(OP_LINESEQ,
+ sigops,
+ newSTATEOP(0, NULL, NULL));
parser->expect = XATTRBLOCK;
LEAVE;
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 19e9dffdb3..557fadd830 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -6043,6 +6043,12 @@ uc(), or ucfirst() (or their string-inlined versions), but you
specified an illegal mapping.
See L<perlunicode/"User-Defined Character Properties">.
+=item Too %s arguments for subroutine
+
+(F) A subroutine using a signature received too few or too many arguments
+than required by the signature. The caller of the subroutine is
+presumably at fault.
+
=item Too deeply nested ()-groups
(F) Your template contains ()-groups with a ridiculously deep nesting level.
@@ -6052,13 +6058,6 @@ See L<perlunicode/"User-Defined Character Properties">.
(F) There has to be at least one argument to syscall() to specify the
system call to call, silly dilly.
-=item Too few arguments for subroutine
-
-(F) A subroutine using a signature received fewer arguments than required
-by the signature. The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
-
=item Too late for "-%s" option
(X) The #! line (or local equivalent) in a Perl script contains the
@@ -6089,13 +6088,6 @@ BEGIN block.
(F) The function requires fewer arguments than you specified.
-=item Too many arguments for subroutine
-
-(F) A subroutine using a signature received more arguments than required
-by the signature. The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
-
=item Too many )'s
(A) You've accidentally run your script through B<csh> instead of Perl.
diff --git a/pp.c b/pp.c
index 8498469d6f..1fba3d97b6 100644
--- a/pp.c
+++ b/pp.c
@@ -6615,6 +6615,212 @@ PP(pp_anonconst)
RETURN;
}
+
+/* process one subroutine argument - typically when the sub has a signature:
+ * introduce PL_curpad[op_targ] and assign to it the value
+ * for $: (OPf_STACKED ? *sp : $_[N])
+ * for @/%: @_[N..$#_]
+ *
+ * It's equivalent to
+ * my $foo = $_[N];
+ * or
+ * my $foo = (value-on-stack)
+ * or
+ * my @foo = @_[N..$#_]
+ * etc
+ *
+ * It assumes that the pad var is currently uninitialised, so this op
+ * should only be used at the start of a sub, where its not possible to
+ * skip the op (e.g. no 'my $x if $cond' stuff for example).
+ */
+
+PP(pp_argelem)
+{
+ dTARG;
+ SV *val;
+ SV ** padentry;
+ OP *o = PL_op;
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ UV ix = PTR2UV(cUNOP_AUXo->op_aux);
+ IV argc;
+ SV **argv;
+
+ assert(!SvMAGICAL(defav));
+
+ /* do 'my $var, @var or %var' action */
+ padentry = &(PAD_SVl(o->op_targ));
+ save_clearsv(padentry);
+ targ = *padentry;
+
+ if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV) {
+ if (o->op_flags & OPf_STACKED) {
+ dSP;
+ val = POPs;
+ PUTBACK;
+ }
+ else {
+ /* should already have been checked */
+ assert(ix < I32_MAX && AvFILLp(defav) >= (I32)ix);
+ val = AvARRAY(defav)[ix];
+ if (UNLIKELY(!val))
+ val = &PL_sv_undef;
+ }
+
+ /* $var = $val */
+
+ /* cargo-culted from pp_sassign */
+ assert(TAINTING_get || !TAINT_get);
+ if (UNLIKELY(TAINT_get) && !SvTAINTED(val))
+ TAINT_NOT;
+
+ /* Short-cut assignment of IV and RV values as these are
+ * common and simple. For RVs, it's likely that on
+ * subsequent calls to a function, targ is already of the
+ * correct storage class */
+ if (LIKELY(!SvMAGICAL(val))) {
+ /* just an IV */
+ if ((SvFLAGS(val) & (SVf_IOK|SVf_NOK|SVf_POK|SVf_IVisUV)) == SVf_IOK) {
+ IV i = SvIVX(val);
+ if (LIKELY(SvTYPE(targ) == SVt_IV)) {
+ assert(!SvOK(targ));
+ assert(!SvMAGICAL(targ));
+ (void)SvIOK_only(targ);
+ SvIV_set(targ, i);
+ }
+ else
+ sv_setiv(targ, i);
+ }
+ else if (SvROK(val) && SvTYPE(targ) == SVt_IV) {
+ /* quick ref assignment */
+ assert(!SvOK(targ));
+ SvRV_set(targ, SvREFCNT_inc(SvRV(val)));
+ SvROK_on(targ);
+ }
+ else
+ sv_setsv(targ, val);
+ }
+ else
+ sv_setsv(targ, val);
+ return o->op_next;
+ }
+
+ /* must be AV or HV */
+
+ assert(!(o->op_flags & OPf_STACKED));
+ argc = ((IV)AvFILLp(defav) + 1) - (IV)ix;
+ assert(!SvMAGICAL(targ));
+ if (argc <= 0)
+ return o->op_next;
+ argv = AvARRAY(defav) + ix;
+ assert(argv);
+
+ /* This is a copy of the relevant parts of pp_aassign().
+ * We *know* that @foo / %foo is a plain empty lexical at this point,
+ * so we can avoid a lot of the extra baggage.
+ * We know, because all the usual tricks like 'my @a if 0',
+ * 'foo: my @a = ...; goto foo' can't be done with signatures.
+ */
+ if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_AV) {
+ UV i = 0;
+
+ assert(AvFILLp((AV*)targ) == -1); /* can skip av_clear() */
+ av_extend((AV*)targ, argc);
+
+ while (argc--) {
+ SV *tmpsv;
+ SV *arg = *argv++;
+ tmpsv = newSV(0);
+ sv_setsv(tmpsv, arg);
+ av_store((AV*)targ, i++, tmpsv);
+ TAINT_NOT;
+ }
+
+ }
+ else {
+ assert((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_HV);
+
+ assert(argc % 2 == 0);
+ assert(!HvTOTALKEYS(targ)); /* can skip hv_clear() */
+
+ while (argc) {
+ SV *tmpsv;
+ SV *key = *argv++;
+ SV *val = *argv++;
+
+ assert(key); assert(val);
+ argc -= 2;
+ if (UNLIKELY(SvGMAGICAL(key)))
+ key = sv_mortalcopy(key);
+ tmpsv = newSV(0);
+ sv_setsv(tmpsv, val);
+ hv_store_ent((HV*)targ, key, tmpsv, 0);
+ TAINT_NOT;
+ }
+ }
+
+ return o->op_next;
+}
+
+/* Handle a default value for one subroutine argument (typically as part
+ * of a subroutine signature).
+ * It's equivalent to
+ * @_ > op_targ ? $_[op_targ] : result_of(op_other)
+ *
+ * Intended to be used where op_next is an OP_ARGELEM
+ *
+ * We abuse the op_targ field slightly: it's an index into @_ rather than
+ * into PL_curpad.
+ */
+
+PP(pp_argdefelem)
+{
+ OP * const o = PL_op;
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ PADOFFSET ix = o->op_targ;
+
+ assert(!SvMAGICAL(defav));
+ assert(ix < I32_MAX);
+ if (AvFILLp(defav) >= (I32)ix) {
+ dSP;
+ XPUSHs(AvARRAY(defav)[ix]);
+ RETURN;
+ }
+ return cLOGOPo->op_other;
+}
+
+
+
+/* Check a a subs arguments - i.e. that it has the correct number of args
+ * (and anything else we might think of in future). Typically used with
+ * signatured subs.
+ */
+
+PP(pp_argcheck)
+{
+ OP * const o = PL_op;
+ UNOP_AUX_item *aux = cUNOP_AUXo->op_aux;
+ UV params = aux[0].uv;
+ UV opt_params = aux[1].uv;
+ char slurpy = (char)(aux[2].iv);
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ UV argc;
+ bool too_few;
+
+ assert(!SvMAGICAL(defav));
+ argc = (UV)(AvFILLp(defav) + 1);
+ too_few = (argc < (params - opt_params));
+
+ if (UNLIKELY(too_few || (!slurpy && argc > params)))
+ Perl_croak_caller("Too %s arguments for subroutine",
+ too_few ? "few" : "many");
+
+ if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2))
+ Perl_croak_caller("Odd name/value argument for subroutine");
+
+
+ return NORMAL;
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/pp_hot.c b/pp_hot.c
index 87346871d6..3f37ce4e32 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -4023,6 +4023,28 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
}
}
+
+
+/* like croak, but report in context of caller */
+
+void
+Perl_croak_caller(const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ const PERL_CONTEXT *cx = caller_cx(0, NULL);
+
+ /* make error appear at call site */
+ assert(cx);
+ PL_curcop = cx->blk_oldcop;
+
+ va_start(args, pat);
+ vcroak(pat, &args);
+ NOT_REACHED; /* NOTREACHED */
+ va_end(args);
+}
+
+
PP(pp_aelem)
{
dSP;
diff --git a/pp_proto.h b/pp_proto.h
index fd54df8e45..16b1729348 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -19,6 +19,9 @@ PERL_CALLCONV OP *Perl_pp_anoncode(pTHX);
PERL_CALLCONV OP *Perl_pp_anonconst(pTHX);
PERL_CALLCONV OP *Perl_pp_anonhash(pTHX);
PERL_CALLCONV OP *Perl_pp_anonlist(pTHX);
+PERL_CALLCONV OP *Perl_pp_argcheck(pTHX);
+PERL_CALLCONV OP *Perl_pp_argdefelem(pTHX);
+PERL_CALLCONV OP *Perl_pp_argelem(pTHX);
PERL_CALLCONV OP *Perl_pp_aslice(pTHX);
PERL_CALLCONV OP *Perl_pp_atan2(pTHX);
PERL_CALLCONV OP *Perl_pp_av2arylen(pTHX);
diff --git a/proto.h b/proto.h
index 0da11b8ab5..eb92412778 100644
--- a/proto.h
+++ b/proto.h
@@ -267,7 +267,6 @@ PERL_CALLCONV U32 Perl_cast_ulong(NV f)
PERL_CALLCONV UV Perl_cast_uv(NV f)
__attribute__warn_unused_result__;
-PERL_CALLCONV OP* Perl_check_arity(pTHX_ int arity, bool max);
PERL_CALLCONV bool Perl_check_utf8_print(pTHX_ const U8 *s, const STRLEN len);
#define PERL_ARGS_ASSERT_CHECK_UTF8_PRINT \
assert(s)
@@ -548,6 +547,10 @@ PERL_CALLCONV_NO_RET void Perl_croak(pTHX_ const char* pat, ...)
__attribute__noreturn__
__attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
+PERL_CALLCONV_NO_RET void Perl_croak_caller(const char* pat, ...)
+ __attribute__noreturn__
+ __attribute__format__null_ok__(__printf__,1,2);
+
PERL_STATIC_NO_RET void S_croak_memory_wrap(void)
__attribute__noreturn__;
@@ -5494,7 +5497,7 @@ STATIC void S_no_op(pTHX_ const char *const what, char *s);
STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar);
#define PERL_ARGS_ASSERT_PARSE_IDENT \
assert(s); assert(d); assert(e)
-STATIC int S_pending_ident(pTHX);
+STATIC int S_pending_ident(pTHX_ bool is_sig);
STATIC char* S_scan_const(pTHX_ char *start)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_SCAN_CONST \
diff --git a/regen/op_private b/regen/op_private
index e291295cd0..478144273c 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -762,6 +762,18 @@ addbits('multideref',
addbits('avhvswitch', '0..1' => { });
+addbits('argelem',
+ '1..2' => {
+ mask_def => 'OPpARGELEM_MASK',
+ enum => [ qw(
+ 0 OPpARGELEM_SV SV
+ 1 OPpARGELEM_AV AV
+ 2 OPpARGELEM_HV HV
+ )],
+ },
+);
+
+
1;
# ex: set ts=8 sts=4 sw=4 et:
diff --git a/regen/opcodes b/regen/opcodes
index b70ff923a9..57dd363c1c 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -299,6 +299,9 @@ method method lookup ck_method d.
entersub subroutine entry ck_subr dm1 L
leavesub subroutine exit ck_null 1
leavesublv lvalue subroutine return ck_null 1
+argcheck check subroutine arguments ck_null +
+argelem subroutine argument ck_null +
+argdefelem subroutine argument default value ck_null |
caller caller ck_fun t% S?
warn warn ck_fun imst@ L
die die ck_fun imst@ L
diff --git a/t/op/signatures.t b/t/op/signatures.t
index 3db1b40aa0..6470586c81 100644
--- a/t/op/signatures.t
+++ b/t/op/signatures.t
@@ -1297,6 +1297,23 @@ is scalar(t117()), undef;
is scalar(@{[ t117(333, 444) ]}), 0;
is scalar(t117(333, 444)), undef;
+sub t145 ($=3) { }
+is scalar(t145()), undef;
+
+{
+ my $want;
+ sub want { $want = wantarray ? "list"
+ : defined(wantarray) ? "scalar" : "void"; 1 }
+
+ sub t144 ($a = want()) { $a }
+ t144();
+ is ($want, "scalar", "default expression is scalar in void context");
+ my $x = t144();
+ is ($want, "scalar", "default expression is scalar in scalar context");
+ () = t144();
+ is ($want, "scalar", "default expression is scalar in list context");
+}
+
use File::Spec::Functions;
my $keywords_file = catfile(updir,'regen','keywords.pl');
open my $kh, $keywords_file
diff --git a/toke.c b/toke.c
index 09d15a950d..74313dc459 100644
--- a/toke.c
+++ b/toke.c
@@ -4545,7 +4545,8 @@ Perl_yylex(pTHX)
PL_lex_allbrackets--;
next_type &= 0xffff;
}
- return REPORT(next_type == 'p' ? pending_ident() : next_type);
+ return REPORT(next_type == 'p' ? pending_ident(0)
+ : next_type == 'P' ? pending_ident(1) : next_type);
}
}
@@ -4837,16 +4838,14 @@ Perl_yylex(pTHX)
s = skipspace(s);
if (isIDFIRST_lazy_if(s, UTF)) {
char *dest = PL_tokenbuf + 1;
- /* on next call to yylex this causes pending_ident()
- * to allocmy() etc */
- PL_in_my = KEY_my;
/* read var name, including sigil, into PL_tokenbuf */
PL_tokenbuf[0] = sigil;
parse_ident(&s, &dest, dest + sizeof(PL_tokenbuf) - 1,
0, cBOOL(UTF), FALSE);
*dest = '\0';
assert(PL_tokenbuf[1]); /* we have a variable name */
- force_ident_maybe_lex(sigil);
+ NEXTVAL_NEXTTOKE.ival = sigil;
+ force_next('P'); /* force a signature pending identifier */
}
PL_expect = XOPERATOR;
break;
@@ -8535,6 +8534,9 @@ Perl_yylex(pTHX)
Looks up an identifier in the pad or in a package
+ is_sig indicates that this is a subroutine signature variable
+ rather than a plain pad var.
+
Returns:
PRIVATEREF if this is a lexical name.
BAREWORD if this belongs to a package.
@@ -8551,7 +8553,7 @@ Perl_yylex(pTHX)
*/
static int
-S_pending_ident(pTHX)
+S_pending_ident(pTHX_ bool is_sig)
{
PADOFFSET tmp = 0;
const char pit = (char)pl_yylval.ival;
@@ -8568,7 +8570,7 @@ S_pending_ident(pTHX)
if it's a legal name, the OP is a PADANY.
*/
- if (PL_in_my) {
+ if (is_sig || PL_in_my) {
if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
if (has_colon)
yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
@@ -8577,6 +8579,7 @@ S_pending_ident(pTHX)
tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
}
else {
+ OP *o;
if (has_colon) {
/* "my" variable %s can't be in a package */
/* PL_no_myglob is constant */
@@ -8589,9 +8592,26 @@ S_pending_ident(pTHX)
GCC_DIAG_RESTORE;
}
- pl_yylval.opval = newOP(OP_PADANY, 0);
- pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
+ if (is_sig) {
+ /* A signature 'padop' needs in addition, an op_first to
+ * point to a child sigdefelem, and an extra field to hold
+ * the signature index. We can achieve both by using an
+ * UNOP_AUX and (ab)using the op_aux field to hold the
+ * index. If we ever need more fields, use a real malloced
+ * aux strut instead.
+ */
+ o = newUNOP_AUX(OP_ARGELEM, 0, NULL,
+ INT2PTR(UNOP_AUX_item *,
+ (UV)(PL_parser->sig_elems)));
+ o->op_private |= ( PL_tokenbuf[0] == '$' ? OPpARGELEM_SV
+ : PL_tokenbuf[0] == '@' ? OPpARGELEM_AV
+ : OPpARGELEM_HV);
+ }
+ else
+ o = newOP(OP_PADANY, 0);
+ o->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
UTF ? SVf_UTF8 : 0);
+ pl_yylval.opval = o;
return PRIVATEREF;
}
}
View Lorry Controller Status