In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/05f7c1e8a76f2b5ef9d680a366d3be0f964c2102?hp=82f82fdb58cb3bf9651ec1ba6904780eb1105021>
- Log -----------------------------------------------------------------
commit 05f7c1e8a76f2b5ef9d680a366d3be0f964c2102
Merge: 82f82fd 82848c1
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Oct 11 10:24:33 2014 -0700
[Merge] Lvalue references
Also:
⢠Single refgen optimisation now applies to \@ \% \& as well.
⢠split-to-array no longer runs the risk of clobbering its argument
and returning junk.
⢠The split-to-array optimisation happens more often than before.
â¢Â foreach my $x is no longer subject to the list-assignment-after-ali-
asing bug (#89646).
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
cop.h | 5 +-
cpan/B-Debug/t/debug.t | 6 +
embed.fnc | 5 +-
embed.h | 6 +-
ext/B/t/concise-xs.t | 4 +
ext/Opcode/Opcode.pm | 4 +-
feature.h | 6 +
lib/B/Deparse.pm | 70 ++-
lib/B/Deparse.t | 266 +++++++-
lib/B/Op_private.pm | 34 +-
lib/feature.pm | 28 +-
lib/warnings.pm | 37 +-
mg.c | 57 ++
mg.h | 1 +
mg_names.c | 1 +
mg_raw.h | 14 +-
mg_vtable.h | 17 +-
op.c | 416 +++++++++++--
opcode.h | 366 ++++++-----
opnames.h | 6 +-
perly.act | 1209 ++++++++++++++++++------------------
perly.h | 64 +-
perly.tab | 1592 ++++++++++++++++++++++++------------------------
perly.y | 37 +-
pod/perldiag.pod | 38 ++
pod/perlexperiment.pod | 12 +
pod/perlguts.pod | 14 +-
pod/perlop.pod | 6 +-
pod/perlref.pod | 103 ++++
pod/perlsyn.pod | 17 +-
pp.c | 206 +++++++
pp_ctl.c | 12 +-
pp_hot.c | 36 +-
pp_proto.h | 4 +
proto.h | 30 +-
regen/feature.pl | 26 +-
regen/mg_vtable.pl | 39 +-
regen/op_private | 23 +-
regen/opcode.pl | 2 +-
regen/opcodes | 4 +
regen/warnings.pl | 4 +-
scope.c | 2 -
sv.c | 10 +-
t/lib/warnings/op | 2 +-
t/op/for.t | 8 +-
t/op/lvref.t | 574 +++++++++++++++++
t/op/ref.t | 4 +-
t/op/split.t | 9 +-
warnings.h | 7 +-
50 files changed, 3707 insertions(+), 1737 deletions(-)
create mode 100644 t/op/lvref.t
diff --git a/MANIFEST b/MANIFEST
index 917f2f9..66ba5df 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5138,6 +5138,7 @@ t/op/local.t See if local works
t/op/lock.t Tests for lock args & retval (no threads)
t/op/loopctl.t See if next/last/redo work
t/op/lop.t See if logical operators work
+t/op/lvref.t See if lvalue references work
t/op/magic-27839.t Test for #27839, skipped for minitest
t/op/magic.t See if magic variables work
t/op/method.t See if method calls work
diff --git a/cop.h b/cop.h
index 37980f0..9c25555 100644
--- a/cop.h
+++ b/cop.h
@@ -761,7 +761,9 @@ struct block_loop {
((c)->blk_loop.itervar_u.oldcomppad \
? (CxPADLOOP(c) \
? CxITERVAR_PADSV(c) \
- : &GvSV((c)->blk_loop.itervar_u.gv)) \
+ : isGV((c)->blk_loop.itervar_u.gv) \
+ ? &GvSV((c)->blk_loop.itervar_u.gv) \
+ : (SV **)&(c)->blk_loop.itervar_u.gv) \
: (SV**)NULL)
#define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop))
@@ -980,6 +982,7 @@ struct context {
/* private flags for CXt_LOOP */
#define CXp_FOR_DEF 0x10 /* foreach using $_ */
+#define CXp_FOR_LVREF 0x20 /* foreach using \$var */
#define CxPADLOOP(c) ((c)->blk_loop.my_op->op_targ)
/* private flags for CXt_SUBST */
diff --git a/cpan/B-Debug/t/debug.t b/cpan/B-Debug/t/debug.t
index e523d3d..0af3bd9 100644
--- a/cpan/B-Debug/t/debug.t
+++ b/cpan/B-Debug/t/debug.t
@@ -59,6 +59,12 @@ leave enter nextstate label leaveloop enterloop null and
defined null
threadsv readline gv lineseq nextstate aassign null pushmark split pushre
threadsv const null pushmark rvav gv nextstate subst const unstack
EOF
+} elsif ($] >= 5.021005) {
+ $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null null
+gvsv readline gv lineseq nextstate split pushre null
+gvsv const nextstate subst const unstack
+EOF
} else {
$b=<<EOF;
leave enter nextstate label leaveloop enterloop null and defined null null
diff --git a/embed.fnc b/embed.fnc
index a0cac62..bceca6b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -554,6 +554,7 @@ Ap |void |gv_name_set |NN GV* gv|NN const char
*name|U32 len|U32 flags
px |GV * |gv_override |NN const char * const name \
|const STRLEN len
XMpd |void |gv_try_downgrade|NN GV* gv
+p |void |gv_setref |NN SV *const dstr|NN SV *const sstr
Apd |HV* |gv_stashpv |NN const char* name|I32 flags
Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
#if defined(PERL_IN_GV_C)
@@ -865,6 +866,7 @@ p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg
p |int |magic_setenv |NN SV* sv|NN MAGIC* mg
dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg
p |int |magic_setisa |NN SV* sv|NN MAGIC* mg
+p |int |magic_setlvref |NN SV* sv|NN MAGIC* mg
p |int |magic_setmglob |NN SV* sv|NN MAGIC* mg
p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg
p |int |magic_setpack |NN SV* sv|NN MAGIC* mg
@@ -1925,7 +1927,7 @@ s |void |fixup_errno_string|NN SV* sv
#if defined(PERL_IN_OP_C)
sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs
-sR |I32 |is_list_assignment|NULLOK const OP *o
+sR |I32 |assignment_type|NULLOK const OP *o
s |void |forget_pmop |NN PMOP *const o
s |void |find_and_forget_pmops |NN OP *o
s |void |cop_free |NN COP *cop
@@ -2350,7 +2352,6 @@ s |SV * |more_sv
s |bool |sv_2iuv_common |NN SV *const sv
s |void |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \
|const int dtype
-s |void |glob_assign_ref|NN SV *const dstr|NN SV *const sstr
sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *const tbl|NULLOK const
void *const sv
s |void |anonymise_cv_maybe |NN GV *gv|NN CV *cv
#endif
diff --git a/embed.h b/embed.h
index d73816f..b4176c7 100644
--- a/embed.h
+++ b/embed.h
@@ -1108,6 +1108,7 @@
#define ck_null(a) Perl_ck_null(aTHX_ a)
#define ck_open(a) Perl_ck_open(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)
#define ck_require(a) Perl_ck_require(aTHX_ a)
#define ck_return(a) Perl_ck_return(aTHX_ a)
@@ -1173,6 +1174,7 @@
#define get_no_modify() Perl_get_no_modify(aTHX)
#define get_opargs() Perl_get_opargs(aTHX)
#define gv_override(a,b) Perl_gv_override(aTHX_ a,b)
+#define gv_setref(a,b) Perl_gv_setref(aTHX_ a,b)
#define gv_try_downgrade(a) Perl_gv_try_downgrade(aTHX_ a)
#define hv_ename_add(a,b,c,d) Perl_hv_ename_add(aTHX_ a,b,c,d)
#define hv_ename_delete(a,b,c,d) Perl_hv_ename_delete(aTHX_ a,b,c,d)
@@ -1225,6 +1227,7 @@
#define magic_setenv(a,b) Perl_magic_setenv(aTHX_ a,b)
#define magic_sethint(a,b) Perl_magic_sethint(aTHX_ a,b)
#define magic_setisa(a,b) Perl_magic_setisa(aTHX_ a,b)
+#define magic_setlvref(a,b) Perl_magic_setlvref(aTHX_ a,b)
#define magic_setmglob(a,b) Perl_magic_setmglob(aTHX_ a,b)
#define magic_setnkeys(a,b) Perl_magic_setnkeys(aTHX_ a,b)
#define magic_setpack(a,b) Perl_magic_setpack(aTHX_ a,b)
@@ -1508,6 +1511,7 @@
#define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
#define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c)
#define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d)
+#define assignment_type(a) S_assignment_type(aTHX_ a)
#define bad_type_gv(a,b,c,d,e) S_bad_type_gv(aTHX_ a,b,c,d,e)
#define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e)
#define clear_special_blocks(a,b,c) S_clear_special_blocks(aTHX_ a,b,c)
@@ -1521,7 +1525,6 @@
#define gen_constant_list(a) S_gen_constant_list(aTHX_ a)
#define inplace_aassign(a) S_inplace_aassign(aTHX_ a)
#define is_handle_constructor S_is_handle_constructor
-#define is_list_assignment(a) S_is_list_assignment(aTHX_ a)
#define listkids(a) S_listkids(aTHX_ a)
#define looks_like_bool(a) S_looks_like_bool(aTHX_ a)
#define modkids(a,b) S_modkids(aTHX_ a,b)
@@ -1662,7 +1665,6 @@
#define find_uninit_var(a,b,c) S_find_uninit_var(aTHX_ a,b,c)
#define glob_2number(a) S_glob_2number(aTHX_ a)
#define glob_assign_glob(a,b,c) S_glob_assign_glob(aTHX_ a,b,c)
-#define glob_assign_ref(a,b) S_glob_assign_ref(aTHX_ a,b)
#define more_sv() S_more_sv(aTHX)
#define not_a_number(a) S_not_a_number(aTHX_ a)
#define not_incrementable(a) S_not_incrementable(aTHX_ a)
diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index dce0a2e..865a164 100644
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -158,6 +158,7 @@ my $testpkgs = {
constant => [qw/ ASSIGN CVf_LVALUE
CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
+ OP_AELEM
OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
OPf_PARENS
OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
@@ -180,6 +181,9 @@ my $testpkgs = {
OPpEVAL_BYTES OPpSUBSTR_REPL_FIRST) : (),
$] >= 5.019 ? qw(OP_PUSHMARK OP_NULL) : (),
'CVf_LOCKED', # This ends up as a constant, pre or post 5.10
+ $] >= 5.021005 ? qw(OPpLVREF_TYPE OPpLVREF_SV
+ OPpLVREF_AV OPpLVREF_HV
+ OPpLVREF_CV OPpLVREF_ELEM) : (),
],
},
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 3da8d94..7256126 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.28";
+$VERSION = "1.29";
use Carp;
use Exporter ();
@@ -402,7 +402,7 @@ These are a hotchpotch of opcodes still waiting to be
considered
once
- rv2gv refgen srefgen ref
+ rv2gv refgen srefgen ref refassign lvref lvrefslice lvavref
bless -- could be used to change ownership of objects
(reblessing)
diff --git a/feature.h b/feature.h
index 698302c..c6c71e3 100644
--- a/feature.h
+++ b/feature.h
@@ -93,6 +93,12 @@
FEATURE_IS_ENABLED("__SUB__")) \
)
+#define FEATURE_LVREF_IS_ENABLED \
+ ( \
+ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+ FEATURE_IS_ENABLED("lvref") \
+ )
+
#define FEATURE_LEXSUBS_IS_ENABLED \
( \
CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 8496611..07cf10f 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -36,7 +36,8 @@ BEGIN {
RXf_PMf_CHARSET RXf_PMf_KEEPCOPY
CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST
PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES
- SVpad_STATE)) {
+ OPpLVREF_TYPE OPpLVREF_SV OPpLVREF_AV OPpLVREF_HV
+ OPpLVREF_CV OPpLVREF_ELEM SVpad_STATE)) {
eval { import B $_ };
no strict 'refs';
*{$_} = sub () {0} unless *{$_}{CODE};
@@ -322,7 +323,7 @@ BEGIN {
-BEGIN { for (qw[ const stringify rv2sv list glob pushmark null]) {
+BEGIN { for (qw[ const stringify rv2sv list glob pushmark null aelem]) {
eval "sub OP_\U$_ () { " . opnumber($_) . "}"
}}
@@ -1216,7 +1217,8 @@ sub maybe_local {
my $self = shift;
my($op, $cx, $text) = @_;
my $name = $op->name;
- my $our_intro = ($name =~ /^(?:(?:gv|rv2)[ash]v|split)$/)
+ my $our_intro = ($name =~ /^(?:(?:gv|rv2)[ash]v|split|refassign
+ |lv(?:av)?ref)$/x)
? OPpOUR_INTRO
: 0;
my $lval_intro = $name eq 'split' ? 0 : OPpLVAL_INTRO;
@@ -2500,7 +2502,7 @@ BEGIN {
'multiply=' => 7, 'i_multiply=' => 7,
'divide=' => 7, 'i_divide=' => 7,
'modulo=' => 7, 'i_modulo=' => 7,
- 'repeat=' => 7,
+ 'repeat=' => 7, 'refassign' => 7, 'refassign=' => 7,
'add=' => 7, 'i_add=' => 7,
'subtract=' => 7, 'i_subtract=' => 7,
'concat=' => 7,
@@ -3054,7 +3056,8 @@ sub pp_list {
my $loppriv = $lop->private;
if (!($loppriv & (OPpLVAL_INTRO|OPpOUR_INTRO)
or $lopname eq "undef")
- or $lopname =~ /^(?:entersub|exit|open|split)\z/)
+ or $lopname =~ /^(?:entersub|exit|open|split
+ |lv(?:av)?ref(?:slice)?)\z/x)
{
$local = ""; # or not
last;
@@ -3233,6 +3236,8 @@ sub loop_common {
}
} elsif ($var->name eq "gv") {
$var = "\$" . $self->deparse($var, 1);
+ } else {
+ $var = $self->deparse($var, 1);
}
$body = $kid->first->first->sibling; # skip OP_AND and OP_ITER
if (!is_state $body->first and $body->first->name !~
/^(?:stub|leave|scope)$/) {
@@ -5104,6 +5109,61 @@ sub pp_padcv {
return $self->padany($op);
}
+my %lvref_funnies = (
+ OPpLVREF_SV, => '$',
+ OPpLVREF_AV, => '@',
+ OPpLVREF_HV, => '%',
+ OPpLVREF_CV, => '&',
+);
+
+sub pp_refassign {
+ my ($self, $op, $cx) = @_;
+ my $left;
+ if ($op->private & OPpLVREF_ELEM) {
+ $left = $op->first ->sibling ->first ->first;
+ # rhs ex-srefgen ex-list ex-[ah]elem
+ $left = maybe_local(@_, elem($self, $left, undef,
+ $left->targ == OP_AELEM
+ ? qw([ ] padav)
+ : qw({ } padhv)));
+ } elsif ($op->flags & OPf_STACKED) {
+ $left = maybe_local(@_,
+ $lvref_funnies{$op->private & OPpLVREF_TYPE}
+ . $self->deparse($op->first->sibling));
+ } else {
+ $left = &pp_padsv;
+ }
+ my $right = $self->deparse_binop_right($op, $op->first, 7);
+ return $self->maybe_parens("\\$left = $right", $cx, 7);
+}
+
+sub pp_lvref {
+ my ($self, $op, $cx) = @_;
+ my $code;
+ if ($op->private & OPpLVREF_ELEM) {
+ $code = $op->first->name =~ /av\z/ ? &pp_aelem : &pp_helem;
+ } elsif ($op->flags & OPf_STACKED) {
+ $code = maybe_local(@_,
+ $lvref_funnies{$op->private & OPpLVREF_TYPE}
+ . $self->deparse($op->first));
+ } else {
+ $code = &pp_padsv;
+ }
+ "\\$code";
+}
+
+sub pp_lvrefslice {
+ my ($self, $op, $cx) = @_;
+ '\\' . ($op->last->name =~ /av\z/ ? &pp_aslice : &pp_hslice);
+}
+
+sub pp_lvavref {
+ my ($self, $op, $cx) = @_;
+ '\\(' . ($op->flags & OPf_STACKED
+ ? maybe_local(@_, rv2x(@_, "\@"))
+ : &pp_padsv) . ')'
+}
+
1;
__END__
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 16b0ad2..21e6cdc 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -92,6 +92,19 @@ EOC
}
}
+# Reset the ambient pragmas
+{
+ my ($b, $w, $h);
+ BEGIN {
+ ($b, $w, $h) = ($^H, ${^WARNING_BITS}, \%^H);
+ }
+ $deparse->ambient_pragmas (
+ hint_bits => $b,
+ warning_bits => $w,
+ '%^H' => $h,
+ );
+}
+
use constant 'c', 'stuff';
is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff',
'the subroutine generated by use constant deparses');
@@ -114,7 +127,7 @@ $a =~ s/.*possible typo.*\n//; # Remove warning line
$a =~ s/.*-i used with no filenames.*\n//; # Remove warning line
$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
-$b = <<'EOF';
+$b = quotemeta <<'EOF';
BEGIN { $^I = ".bak"; }
BEGIN { $^W = 1; }
BEGIN { $/ = "\n"; $\ = "\n"; }
@@ -124,7 +137,8 @@ LINE: while (defined($_ = <ARGV>)) {
'???';
}
EOF
-is($a, $b,
+$b =~ s/our\\\(\\\@F\\\)/our[( ]\@F\\)?/; # accept both our @F and our(@F)
+like($a, qr/$b/,
'command line flags deparse as BEGIN blocks setting control variables');
$a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`;
@@ -1602,3 +1616,251 @@ main::pop();
state();
use feature 'state';
main::state();
+####
+# lvalue references
+# CONTEXT use feature "state", 'lvalue_refs', 'lexical_subs'; no warnings
'experimental';
+our $x;
+\$x = \$x;
+my $m;
+\$m = \$x;
+\my $n = \$x;
+(\$x) = @_;
+\($x) = @_;
+\($m) = @_;
+(\$m) = @_;
+\my($p) = @_;
+(\my $r) = @_;
+\($x, my $a) = @{[\$x, \$x]};
+(\$x, \my $b) = @{[\$x, \$x]};
+\local $x = \3;
+\local($x) = \3;
+\state $c = \3;
+\state($d) = \3;
+\our $e = \3;
+\our($f) = \3;
+\$_[0] = foo();
+\($_[1]) = foo();
+my @a;
+\$a[0] = foo();
+\($a[1]) = foo();
+\local($a[1]) = foo();
+\@a[0,1] = foo();
+\(@a[2,3]) = foo();
+\local @a[0,1] = (\$a)x2;
+\$_{a} = foo();
+\($_{b}) = foo();
+my %h;
+\$h{a} = foo();
+\($h{b}) = foo();
+\local $h{a} = \$x;
+\local($h{b}) = \$x;
+\@h{'a','b'} = foo();
+\(@h{2,3}) = foo();
+\local @h{'a','b'} = (\$x)x2;
+\@_ = foo();
+\@a = foo();
+(\@_) = foo();
+(\@a) = foo();
+\my @c = foo();
+(\my @d) = foo();
+\(@_) = foo();
+\(@a) = foo();
+\my(@g) = foo();
+\local @_ = \@_;
+(\local @_) = \@_;
+\state @e = [1..3];
+\state(@f) = \3;
+\our @i = [1..3];
+\our(@h) = \3;
+\%_ = foo();
+\%h = foo();
+(\%_) = foo();
+(\%h) = foo();
+\my %c = foo();
+(\my %d) = foo();
+\local %_ = \%h;
+(\local %_) = \%h;
+\state %y = {1,2};
+\our %z = {1,2};
+(\our %zz) = {1,2};
+\&a = foo();
+(\&a) = foo();
+\(&a) = foo();
+{
+ my sub a;
+ \&a = foo();
+ (\&a) = foo();
+ \(&a) = foo();
+}
+(\$_, $_) = \(1, 2);
+$_ == 3 ? \$_ : $_ = \3;
+$_ == 3 ? \$_ : \$x = \3;
+\($_ == 3 ? $_ : $x) = \3;
+for \my $topic (\$1, \$2) {
+ die;
+}
+for \state $topic (\$1, \$2) {
+ die;
+}
+for \our $topic (\$1, \$2) {
+ die;
+}
+for \$_ (\$1, \$2) {
+ die;
+}
+for \my @a ([1,2], [3,4]) {
+ die;
+}
+for \state @a ([1,2], [3,4]) {
+ die;
+}
+for \our @a ([1,2], [3,4]) {
+ die;
+}
+for \@_ ([1,2], [3,4]) {
+ die;
+}
+for \my %a ({5,6}, {7,8}) {
+ die;
+}
+for \our %a ({5,6}, {7,8}) {
+ die;
+}
+for \state %a ({5,6}, {7,8}) {
+ die;
+}
+for \%_ ({5,6}, {7,8}) {
+ die;
+}
+{
+ my sub a;
+ for \&a (sub { 9; }, sub { 10; }) {
+ die;
+ }
+}
+for \&a (sub { 9; }, sub { 10; }) {
+ die;
+}
+>>>>
+our $x;
+\$x = \$x;
+my $m;
+\$m = \$x;
+\my $n = \$x;
+(\$x) = @_;
+(\$x) = @_;
+(\$m) = @_;
+(\$m) = @_;
+(\my $p) = @_;
+(\my $r) = @_;
+(\$x, \my $a) = @{[\$x, \$x];};
+(\$x, \my $b) = @{[\$x, \$x];};
+\local $x = \3;
+(\local $x) = \3;
+\state $c = \3;
+(\state $d) = \3;
+\our $e = \3;
+(\our $f) = \3;
+\$_[0] = foo();
+(\$_[1]) = foo();
+my @a;
+\$a[0] = foo();
+(\$a[1]) = foo();
+(\local $a[1]) = foo();
+(\@a[0, 1]) = foo();
+(\@a[2, 3]) = foo();
+(\local @a[0, 1]) = (\$a) x 2;
+\$_{'a'} = foo();
+(\$_{'b'}) = foo();
+my %h;
+\$h{'a'} = foo();
+(\$h{'b'}) = foo();
+\local $h{'a'} = \$x;
+(\local $h{'b'}) = \$x;
+(\@h{'a', 'b'}) = foo();
+(\@h{2, 3}) = foo();
+(\local @h{'a', 'b'}) = (\$x) x 2;
+\@_ = foo();
+\@a = foo();
+(\@_) = foo();
+(\@a) = foo();
+\my @c = foo();
+(\my @d) = foo();
+(\(@_)) = foo();
+(\(@a)) = foo();
+(\(my @g)) = foo();
+\local @_ = \@_;
+(\local @_) = \@_;
+\state @e = [1..3];
+(\(state @f)) = \3;
+\our @i = [1..3];
+(\(our @h)) = \3;
+\%_ = foo();
+\%h = foo();
+(\%_) = foo();
+(\%h) = foo();
+\my %c = foo();
+(\my %d) = foo();
+\local %_ = \%h;
+(\local %_) = \%h;
+\state %y = {1, 2};
+\our %z = {1, 2};
+(\our %zz) = {1, 2};
+\&a = foo();
+(\&a) = foo();
+(\&a) = foo();
+{
+ my sub a;
+ \&a = foo();
+ (\&a) = foo();
+ (\&a) = foo();
+}
+(\$_, $_) = \(1, 2);
+$_ == 3 ? \$_ : $_ = \3;
+$_ == 3 ? \$_ : \$x = \3;
+($_ == 3 ? \$_ : \$x) = \3;
+foreach \my $topic (\$1, \$2) {
+ die;
+}
+foreach \state $topic (\$1, \$2) {
+ die;
+}
+foreach \our $topic (\$1, \$2) {
+ die;
+}
+foreach \$_ (\$1, \$2) {
+ die;
+}
+foreach \my @a ([1, 2], [3, 4]) {
+ die;
+}
+foreach \state @a ([1, 2], [3, 4]) {
+ die;
+}
+foreach \our @a ([1, 2], [3, 4]) {
+ die;
+}
+foreach \@_ ([1, 2], [3, 4]) {
+ die;
+}
+foreach \my %a ({5, 6}, {7, 8}) {
+ die;
+}
+foreach \our %a ({5, 6}, {7, 8}) {
+ die;
+}
+foreach \state %a ({5, 6}, {7, 8}) {
+ die;
+}
+foreach \%_ ({5, 6}, {7, 8}) {
+ die;
+}
+{
+ my sub a;
+ foreach \&a (sub { 9; } , sub { 10; } ) {
+ die;
+ }
+}
+foreach \&a (sub { 9; } , sub { 10; } ) {
+ die;
+}
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 19e9561..5586ec7 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -128,7 +128,9 @@ $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
$bits{$_}{2} = 'OPpITER_REVERSED' for qw(enteriter iter);
$bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
$bits{$_}{4} = 'OPpLVAL_DEFER' for qw(aelem helem);
-$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter
entersub gvsv helem hslice list padav padhv padrange padsv pushmark rv2av rv2gv
rv2hv rv2sv);
+$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter
entersub gvsv helem hslice list lvavref lvref lvrefslice padav padhv padrange
padsv pushmark refassign rv2av rv2gv rv2hv ... [7 chars truncated]
+$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
+$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem
hslice keys kvaslice kvhslice padav padhv pos rkeys rv2av rv2gv rv2hv substr
vec);
$bits{$_}{6} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
@@ -137,7 +139,7 @@ $bits{$_}{4} = 'OPpOPEN_IN_RAW' for qw(backtick open);
$bits{$_}{7} = 'OPpOPEN_OUT_CRLF' for qw(backtick open);
$bits{$_}{6} = 'OPpOPEN_OUT_RAW' for qw(backtick open);
$bits{$_}{4} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split);
-$bits{$_}{4} = 'OPpPAD_STATE' for qw(padav padhv padsv pushmark);
+$bits{$_}{4} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark
refassign);
$bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
$bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv
leavewrite);
$bits{$_}{6} = 'OPpRUNTIME' for qw(match pushre qr subst substcont);
@@ -206,6 +208,18 @@ my @bf = (
3, 'OPpDEREF_SV', 'DREFSV',
],
},
+ {
+ mask_def => 'OPpLVREF_TYPE',
+ bitmin => 5,
+ bitmax => 6,
+ bitmask => 96,
+ enum => [
+ 0, 'OPpLVREF_SV', 'SV',
+ 1, 'OPpLVREF_AV', 'AV',
+ 2, 'OPpLVREF_HV', 'HV',
+ 3, 'OPpLVREF_CV', 'CV',
+ ],
+ },
);
@{$bits{aassign}}{6,1,0} = ('OPpASSIGN_COMMON', $bf[1], $bf[1]);
@@ -381,6 +395,8 @@ $bits{log}{0} = $bf[0];
@{$bits{lslice}}{1,0} = ($bf[1], $bf[1]);
$bits{lstat}{0} = $bf[0];
@{$bits{lt}}{1,0} = ($bf[1], $bf[1]);
+$bits{lvavref}{0} = $bf[0];
+@{$bits{lvref}}{6,5,0} = ($bf[7], $bf[7], $bf[0]);
$bits{mapwhile}{0} = $bf[0];
$bits{method}{0} = $bf[0];
$bits{method_named}{0} = $bf[0];
@@ -427,6 +443,7 @@ $bits{readlink}{0} = $bf[0];
@{$bits{recv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
$bits{redo}{0} = $bf[0];
$bits{ref}{0} = $bf[0];
+@{$bits{refassign}}{6,5,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]);
$bits{refgen}{0} = $bf[0];
$bits{regcmaybe}{0} = $bf[0];
$bits{regcomp}{0} = $bf[0];
@@ -576,6 +593,13 @@ our %defines = (
OPpLVALUE => 128,
OPpLVAL_DEFER => 16,
OPpLVAL_INTRO => 128,
+ OPpLVREF_AV => 32,
+ OPpLVREF_CV => 96,
+ OPpLVREF_ELEM => 4,
+ OPpLVREF_HV => 64,
+ OPpLVREF_ITER => 8,
+ OPpLVREF_SV => 0,
+ OPpLVREF_TYPE => 96,
OPpMAYBE_LVSUB => 8,
OPpMAYBE_TRUEBOOL => 64,
OPpMAY_RETURN_CONSTANT => 64,
@@ -661,6 +685,12 @@ our %labels = (
OPpLVALUE => 'LV',
OPpLVAL_DEFER => 'LVDEFER',
OPpLVAL_INTRO => 'LVINTRO',
+ OPpLVREF_AV => 'AV',
+ OPpLVREF_CV => 'CV',
+ OPpLVREF_ELEM => 'ELEM',
+ OPpLVREF_HV => 'HV',
+ OPpLVREF_ITER => 'ITER',
+ OPpLVREF_SV => 'SV',
OPpMAYBE_LVSUB => 'LVSUB',
OPpMAYBE_TRUEBOOL => 'BOOL?',
OPpMAY_RETURN_CONSTANT => 'CONST',
diff --git a/lib/feature.pm b/lib/feature.pm
index 89765c6..3f93f23 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -5,7 +5,7 @@
package feature;
-our $VERSION = '1.37';
+our $VERSION = '1.38';
our %feature = (
fc => 'feature_fc',
@@ -17,6 +17,7 @@ our %feature = (
array_base => 'feature_arybase',
signatures => 'feature_signatures',
current_sub => 'feature___SUB__',
+ lvalue_refs => 'feature_lvref',
lexical_subs => 'feature_lexsubs',
postderef_qq => 'feature_postderef_qq',
unicode_eval => 'feature_unieval',
@@ -27,7 +28,7 @@ our %feature_bundle = (
"5.10" => [qw(array_base say state switch)],
"5.11" => [qw(array_base say state switch unicode_strings)],
"5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval
unicode_strings)],
- "all" => [qw(array_base current_sub evalbytes fc lexical_subs
postderef postderef_qq say signatures state switch unicode_eval
unicode_strings)],
+ "all" => [qw(array_base current_sub evalbytes fc lexical_subs
lvalue_refs postderef postderef_qq say signatures state switch unicode_eval
unicode_strings)],
"default" => [qw(array_base)],
);
@@ -268,6 +269,29 @@ See L<perlsub/Signatures> for details.
This feature is available from Perl 5.20 onwards.
+=head2 The 'lvalue_refs' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the
+warning:
+
+ no warnings "experimental::lvalue_refs";
+
+This enables aliasing via assignment to references:
+
+ \$a = \$b; # $a and $b now point to the same scalar
+ \@a = \@b; # to the same array
+ \%a = \%b;
+ \&a = \&b;
+ foreach \%hash (@array_of_hash_refs) {
+ ...
+ }
+
+See L<perlref/Assigning to References> for details.
+
+This feature is available from Perl 5.22 onwards.
+
=head1 FEATURE BUNDLES
It's possible to load multiple features together, using
diff --git a/lib/warnings.pm b/lib/warnings.pm
index a08be18..5f7a20d 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
package warnings;
-our $VERSION = '1.26';
+our $VERSION = '1.27';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
@@ -269,6 +269,8 @@ The current hierarchy is:
| |
| +- experimental::lexical_topic
| |
+ | +- experimental::lvalue_refs
+ | |
| +- experimental::postderef
| |
| +- experimental::regex_sets
@@ -825,13 +827,14 @@ our %Offsets = (
# Warnings Categories added in Perl 5.021
- 'experimental::win32_perlio'=> 120,
- 'missing' => 122,
- 'redundant' => 124,
+ 'experimental::lvalue_refs'=> 120,
+ 'experimental::win32_perlio'=> 122,
+ 'missing' => 124,
+ 'redundant' => 126,
);
our %Bits = (
- 'all' =>
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..62]
+ 'all' =>
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..63]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' =>
"\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' =>
"\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -841,15 +844,16 @@ our %Bits = (
'digit' =>
"\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' =>
"\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' =>
"\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x01", #
[51..58,60]
+ 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x05", #
[51..58,60,61]
'experimental::autoderef'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [56]
'experimental::lexical_subs'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [52]
'experimental::lexical_topic'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [53]
+ 'experimental::lvalue_refs'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [60]
'experimental::postderef'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [57]
'experimental::regex_sets'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [54]
'experimental::signatures'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [58]
'experimental::smartmatch'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [55]
- 'experimental::win32_perlio'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [60]
+ 'experimental::win32_perlio'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [61]
'glob' =>
"\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [47]
'imprecision' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [46]
@@ -859,7 +863,7 @@ our %Bits = (
'layer' =>
"\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
'malloc' =>
"\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
'misc' =>
"\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [61]
+ 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [62]
'newline' =>
"\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
'non_unicode' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [48]
'nonchar' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [49]
@@ -876,7 +880,7 @@ our %Bits = (
'qw' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [36]
'recursion' =>
"\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' =>
"\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
- 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [62]
+ 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [63]
'regexp' =>
"\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [38]
@@ -897,7 +901,7 @@ our %Bits = (
);
our %DeadBits = (
- 'all' =>
"\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..62]
+ 'all' =>
"\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..63]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
'bareword' =>
"\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
'closed' =>
"\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -907,15 +911,16 @@ our %DeadBits = (
'digit' =>
"\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' =>
"\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' =>
"\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\x02", #
[51..58,60]
+ 'experimental' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\x0a", #
[51..58,60,61]
'experimental::autoderef'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [56]
'experimental::lexical_subs'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [52]
'experimental::lexical_topic'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [53]
+ 'experimental::lvalue_refs'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [60]
'experimental::postderef'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [57]
'experimental::regex_sets'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [54]
'experimental::signatures'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [58]
'experimental::smartmatch'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [55]
- 'experimental::win32_perlio'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [60]
+ 'experimental::win32_perlio'=>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [61]
'glob' =>
"\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [47]
'imprecision' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [46]
@@ -925,7 +930,7 @@ our %DeadBits = (
'layer' =>
"\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
'malloc' =>
"\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
'misc' =>
"\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [61]
+ 'missing' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [62]
'newline' =>
"\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
'non_unicode' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [48]
'nonchar' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [49]
@@ -942,7 +947,7 @@ our %DeadBits = (
'qw' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [36]
'recursion' =>
"\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
'redefine' =>
"\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
- 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [62]
+ 'redundant' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [63]
'regexp' =>
"\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
'reserved' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [37]
'semicolon' =>
"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [38]
@@ -963,8 +968,8 @@ our %DeadBits = (
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-$DEFAULT =
"\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x01", #
[2,56,52,53,57,54,58,55,60,4,22,23,25]
-$LAST_BIT = 126 ;
+$DEFAULT =
"\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x05", #
[2,56,52,53,60,57,54,58,55,61,4,22,23,25]
+$LAST_BIT = 128 ;
$BYTES = 16 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
diff --git a/mg.c b/mg.c
index 9653c70..bf98374 100644
--- a/mg.c
+++ b/mg.c
@@ -2462,6 +2462,63 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
}
int
+Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
+{
+ const char *bad = NULL;
+ PERL_ARGS_ASSERT_MAGIC_SETLVREF;
+ if (!SvROK(sv)) Perl_croak(aTHX_ "Assigned value is not a reference");
+ switch (mg->mg_private & OPpLVREF_TYPE) {
+ case OPpLVREF_SV:
+ if (SvTYPE(SvRV(sv)) > SVt_PVLV)
+ bad = " SCALAR";
+ break;
+ case OPpLVREF_AV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVAV)
+ bad = "n ARRAY";
+ break;
+ case OPpLVREF_HV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVHV)
+ bad = " HASH";
+ break;
+ case OPpLVREF_CV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVCV)
+ bad = " CODE";
+ }
+ if (bad)
+ /* diag_listed_as: Assigned value is not %s reference */
+ Perl_croak(aTHX_ "Assigned value is not a%s reference", bad);
+ switch (mg->mg_obj ? SvTYPE(mg->mg_obj) : 0) {
+ case 0:
+ {
+ SV * const old = PAD_SV(mg->mg_len);
+ PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv)));
+ SvREFCNT_dec(old);
+ break;
+ }
+ case SVt_PVGV:
+ gv_setref(mg->mg_obj, sv);
+ SvSETMAGIC(mg->mg_obj);
+ break;
+ case SVt_PVAV:
+ av_store((AV *)mg->mg_obj, SvIV((SV *)mg->mg_ptr),
+ SvREFCNT_inc_simple_NN(SvRV(sv)));
+ break;
+ case SVt_PVHV:
+ hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr,
+ SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+ }
+ if (mg->mg_flags & MGf_PERSIST)
+ NOOP; /* This sv is in use as an iterator var and will be reused,
+ so we must leave the magic. */
+ else
+ /* This sv could be returned by the assignment op, so clear the
+ magic, as lvrefs are an implementation detail that must not be
+ leaked to the user. */
+ sv_unmagic(sv, PERL_MAGIC_lvref);
+ return 0;
+}
+
+int
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
#ifdef USE_ITHREADS
diff --git a/mg.h b/mg.h
index 0f2fa29..3aa2401 100644
--- a/mg.h
+++ b/mg.h
@@ -40,6 +40,7 @@ struct magic {
#define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */
#define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */
#define MGf_BYTES 0x40 /* PERL_MAGIC_regex_global only */
+#define MGf_PERSIST 0x80 /* PERL_MAGIC_lvref only */
#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR)
#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR)
diff --git a/mg_names.c b/mg_names.c
index 52eed71..237dfc5 100644
--- a/mg_names.c
+++ b/mg_names.c
@@ -47,6 +47,7 @@
{ PERL_MAGIC_utf8, "utf8(w)" },
{ PERL_MAGIC_substr, "substr(x)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
+ { PERL_MAGIC_lvref, "lvref(\\)" },
{ PERL_MAGIC_checkcall, "checkcall(])" },
{ PERL_MAGIC_ext, "ext(~)" },
diff --git a/mg_raw.h b/mg_raw.h
index 984f1d7..4b3d35d 100644
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -11,7 +11,7 @@
{ '#', "want_vtbl_arylen | PERL_MAGIC_VALUE_MAGIC",
"/* arylen '#' Array length ($#ary) */" },
{ '%', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC",
- "/* rhash '%' extra data for restricted hashes */" },
+ "/* rhash '%' Extra data for restricted hashes */" },
{ '&', "magic_vtable_max",
"/* proto '&' my sub prototype CV */" },
{ '*', "want_vtbl_debugvar",
@@ -19,11 +19,11 @@
{ '.', "want_vtbl_pos | PERL_MAGIC_VALUE_MAGIC",
"/* pos '.' pos() lvalue */" },
{ ':', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC",
- "/* symtab ':' extra data for symbol tables */" },
+ "/* symtab ':' Extra data for symbol tables */" },
{ '<', "want_vtbl_backref | PERL_MAGIC_READONLY_ACCEPTABLE |
PERL_MAGIC_VALUE_MAGIC",
- "/* backref '<' for weak ref data */" },
+ "/* backref '<' For weak ref data */" },
{ '@', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC",
- "/* arylen_p '@' to move arylen out of XPVAV */" },
+ "/* arylen_p '@' To move arylen out of XPVAV */" },
{ 'B', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE |
PERL_MAGIC_VALUE_MAGIC",
"/* bm 'B' Boyer-Moore (fast string search) */" },
{ 'c', "want_vtbl_ovrld",
@@ -63,7 +63,7 @@
{ 'q', "want_vtbl_packelem",
"/* tiedscalar 'q' Tied scalar or handle */" },
{ 'r', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE |
PERL_MAGIC_VALUE_MAGIC",
- "/* qr 'r' precompiled qr// regex */" },
+ "/* qr 'r' Precompiled qr// regex */" },
{ 'S', "magic_vtable_max",
"/* sig 'S' %SIG hash */" },
{ 's', "want_vtbl_sigelem",
@@ -82,8 +82,10 @@
"/* substr 'x' substr() lvalue */" },
{ 'y', "want_vtbl_defelem | PERL_MAGIC_VALUE_MAGIC",
"/* defelem 'y' Shadow \"foreach\" iterator variable / smart parameter
vivification */" },
+ { '\\', "want_vtbl_lvref",
+ "/* lvref '\\' Lvalue reference in list assignment */" },
{ ']', "want_vtbl_checkcall | PERL_MAGIC_VALUE_MAGIC",
- "/* checkcall ']' inlining/mutation of call to this CV */" },
+ "/* checkcall ']' Inlining/mutation of call to this CV */" },
{ '~', "magic_vtable_max",
"/* ext '~' Available for use by extensions */" },
diff --git a/mg_vtable.h b/mg_vtable.h
index 104e936..2ee6361 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -14,13 +14,13 @@
#define PERL_MAGIC_sv '\0' /* Special scalar variable */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
-#define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */
+#define PERL_MAGIC_rhash '%' /* Extra data for restricted hashes */
#define PERL_MAGIC_proto '&' /* my sub prototype CV */
#define PERL_MAGIC_debugvar '*' /* $DB::single, signal, trace vars */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
-#define PERL_MAGIC_symtab ':' /* extra data for symbol tables */
-#define PERL_MAGIC_backref '<' /* for weak ref data */
-#define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */
+#define PERL_MAGIC_symtab ':' /* Extra data for symbol tables */
+#define PERL_MAGIC_backref '<' /* For weak ref data */
+#define PERL_MAGIC_arylen_p '@' /* To move arylen out of XPVAV */
#define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */
#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
#define PERL_MAGIC_regdata 'D' /* Regex match position data
@@ -43,7 +43,7 @@
#define PERL_MAGIC_tied 'P' /* Tied array or hash */
#define PERL_MAGIC_tiedelem 'p' /* Tied array or hash element */
#define PERL_MAGIC_tiedscalar 'q' /* Tied scalar or handle */
-#define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
+#define PERL_MAGIC_qr 'r' /* Precompiled qr// regex */
#define PERL_MAGIC_sig 'S' /* %SIG hash */
#define PERL_MAGIC_sigelem 's' /* %SIG hash element */
#define PERL_MAGIC_taint 't' /* Taintedness */
@@ -55,7 +55,8 @@
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable /
smart parameter vivification */
-#define PERL_MAGIC_checkcall ']' /* inlining/mutation of call to this CV
*/
+#define PERL_MAGIC_lvref '\\' /* Lvalue reference in list assignment
*/
+#define PERL_MAGIC_checkcall ']' /* Inlining/mutation of call to this CV
*/
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
enum { /* pass one of these to get_vtbl */
@@ -73,6 +74,7 @@ enum { /* pass one of these to get_vtbl */
want_vtbl_hintselem,
want_vtbl_isa,
want_vtbl_isaelem,
+ want_vtbl_lvref,
want_vtbl_mglob,
want_vtbl_nkeys,
want_vtbl_ovrld,
@@ -108,6 +110,7 @@ EXTCONST char * const
PL_magic_vtable_names[magic_vtable_max] = {
"hintselem",
"isa",
"isaelem",
+ "lvref",
"mglob",
"nkeys",
"ovrld",
@@ -166,6 +169,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
{ 0, Perl_magic_sethint, 0, Perl_magic_clearhint, 0, 0, 0, 0 },
{ 0, Perl_magic_setisa, 0, Perl_magic_clearisa, 0, 0, 0, 0 },
{ 0, Perl_magic_setisa, 0, 0, 0, 0, 0, 0 },
+ { 0, Perl_magic_setlvref, 0, 0, 0, 0, 0, 0 },
{ 0, Perl_magic_setmglob, 0, 0, 0, 0, 0, 0 },
{ Perl_magic_getnkeys, Perl_magic_setnkeys, 0, 0, 0, 0, 0, 0 },
{ 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 },
@@ -210,6 +214,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
#define PL_vtbl_hintselem PL_magic_vtables[want_vtbl_hintselem]
#define PL_vtbl_isa PL_magic_vtables[want_vtbl_isa]
#define PL_vtbl_isaelem PL_magic_vtables[want_vtbl_isaelem]
+#define PL_vtbl_lvref PL_magic_vtables[want_vtbl_lvref]
#define PL_vtbl_mglob PL_magic_vtables[want_vtbl_mglob]
#define PL_vtbl_nkeys PL_magic_vtables[want_vtbl_nkeys]
#define PL_vtbl_ovrld PL_magic_vtables[want_vtbl_ovrld]
diff --git a/op.c b/op.c
index 1496db5..d763b62 100644
--- a/op.c
+++ b/op.c
@@ -1802,7 +1802,8 @@ Perl_scalarvoid(pTHX_ OP *o)
refgen = (UNOP *)((BINOP *)o)->op_first;
- if (!refgen || refgen->op_type != OP_REFGEN)
+ if (!refgen || (refgen->op_type != OP_REFGEN
+ && refgen->op_type != OP_SREFGEN))
break;
exlist = (LISTOP *)refgen->op_first;
@@ -1810,7 +1811,8 @@ Perl_scalarvoid(pTHX_ OP *o)
|| exlist->op_targ != OP_LIST)
break;
- if (exlist->op_first->op_type != OP_PUSHMARK)
+ if (exlist->op_first->op_type != OP_PUSHMARK
+ && exlist->op_first != exlist->op_last)
break;
rv2cv = (UNOP*)exlist->op_last;
@@ -2333,6 +2335,130 @@ S_vivifies(const OPCODE type)
return 0;
}
+static void
+S_lvref(pTHX_ OP *o, I32 type)
+{
+ OP *kid;
+ switch (o->op_type) {
+ case OP_COND_EXPR:
+ for (kid = OP_SIBLING(cUNOPo->op_first); kid;
+ kid = OP_SIBLING(kid))
+ S_lvref(aTHX_ kid, type);
+ /* FALLTHROUGH */
+ case OP_PUSHMARK:
+ return;
+ case OP_RV2AV:
+ if (cUNOPo->op_first->op_type != OP_GV) goto badref;
+ o->op_flags |= OPf_STACKED;
+ if (o->op_flags & OPf_PARENS) {
+ if (o->op_private & OPpLVAL_INTRO) {
+ /* diag_listed_as: Can't modify %s in %s */
+ yyerror(Perl_form(aTHX_ "Can't modify reference to "
+ "localized parenthesized array in list assignment"));
+ return;
+ }
+ slurpy:
+ o->op_type = OP_LVAVREF;
+ o->op_ppaddr = PL_ppaddr[OP_LVAVREF];
+ o->op_private &= OPpLVAL_INTRO|OPpPAD_STATE;
+ o->op_flags |= OPf_MOD|OPf_REF;
+ return;
+ }
+ o->op_private |= OPpLVREF_AV;
+ goto checkgv;
+ case OP_RV2CV:
+ kid = cUNOPo->op_first;
+ if (kid->op_type == OP_NULL)
+ kid = cUNOPx(kUNOP->op_first->op_sibling)
+ ->op_first;
+ o->op_private = OPpLVREF_CV;
+ if (kid->op_type == OP_GV)
+ o->op_flags |= OPf_STACKED;
+ else if (kid->op_type == OP_PADCV) {
+ o->op_targ = kid->op_targ;
+ kid->op_targ = 0;
+ op_free(cUNOPo->op_first);
+ cUNOPo->op_first = NULL;
+ o->op_flags &=~ OPf_KIDS;
+ }
+ else goto badref;
+ break;
+ case OP_RV2HV:
+ if (o->op_flags & OPf_PARENS) {
+ parenhash:
+ /* diag_listed_as: Can't modify %s in %s */
+ yyerror(Perl_form(aTHX_ "Can't modify reference to "
+ "parenthesized hash in list assignment"));
+ return;
+ }
+ o->op_private |= OPpLVREF_HV;
+ /* FALLTHROUGH */
+ case OP_RV2SV:
+ checkgv:
+ if (cUNOPo->op_first->op_type != OP_GV) goto badref;
+ o->op_flags |= OPf_STACKED;
+ break;
+ case OP_PADHV:
+ if (o->op_flags & OPf_PARENS) goto parenhash;
+ o->op_private |= OPpLVREF_HV;
+ /* FALLTHROUGH */
+ case OP_PADSV:
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
+ break;
+ case OP_PADAV:
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
+ if (o->op_flags & OPf_PARENS) goto slurpy;
+ o->op_private |= OPpLVREF_AV;
+ break;
+ case OP_AELEM:
+ case OP_HELEM:
+ o->op_private |= OPpLVREF_ELEM;
+ o->op_flags |= OPf_STACKED;
+ break;
+ case OP_ASLICE:
+ case OP_HSLICE:
+ o->op_type = OP_LVREFSLICE;
+ o->op_ppaddr = PL_ppaddr[OP_LVREFSLICE];
+ o->op_private &= OPpLVAL_INTRO|OPpLVREF_ELEM;
+ return;
+ case OP_NULL:
+ if (o->op_flags & OPf_SPECIAL) /* do BLOCK */
+ goto badref;
+ else if (!(o->op_flags & OPf_KIDS))
+ return;
+ if (o->op_targ != OP_LIST) {
+ S_lvref(aTHX_ cBINOPo->op_first, type);
+ return;
+ }
+ /* FALLTHROUGH */
+ case OP_LIST:
+ for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid)) {
+ assert((kid->op_flags & OPf_WANT) != OPf_WANT_VOID);
+ S_lvref(aTHX_ kid, type);
+ }
+ return;
+ case OP_STUB:
+ if (o->op_flags & OPf_PARENS)
+ return;
+ /* FALLTHROUGH */
+ default:
+ badref:
+ /* diag_listed_as: Can't modify %s in %s */
+ yyerror(Perl_form(aTHX_ "Can't modify reference to %s in %s",
+ o->op_type == OP_NULL && o->op_flags & OPf_SPECIAL
+ ? "do block"
+ : OP_DESC(o),
+ PL_op_desc[type]));
+ return;
+ }
+ o->op_type = OP_LVREF;
+ o->op_ppaddr = PL_ppaddr[OP_LVREF];
+ o->op_private &=
+ OPpLVAL_INTRO|OPpLVREF_ELEM|OPpLVREF_TYPE|OPpPAD_STATE;
+ if (type == OP_ENTERLOOP)
+ o->op_private |= OPpLVREF_ITER;
+}
+
OP *
Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
{
@@ -2626,6 +2752,35 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
|| !S_vivifies(OP_SIBLING(cLOGOPo->op_first)->op_type))
op_lvalue(OP_SIBLING(cLOGOPo->op_first), type);
goto nomod;
+
+ case OP_SREFGEN:
+ if (type != OP_AASSIGN && type != OP_SASSIGN
+ && type != OP_ENTERLOOP)
+ goto nomod;
+ /* Donât bother applying lvalue context to the ex-list. */
+ kid = cUNOPx(cUNOPo->op_first)->op_first;
+ assert (!OP_HAS_SIBLING(kid));
+ goto kid_2lvref;
+ case OP_REFGEN:
+ if (type != OP_AASSIGN) goto nomod;
+ kid = cUNOPo->op_first;
+ kid_2lvref:
+ {
+ const U8 ec = PL_parser ? PL_parser->error_count : 0;
+ S_lvref(aTHX_ kid, type);
+ if (!PL_parser || PL_parser->error_count == ec) {
+ if (!FEATURE_LVREF_IS_ENABLED)
+ Perl_croak(aTHX_
+ "Experimental lvalue references not enabled");
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
+ "Lvalue references are experimental");
+ }
+ }
+ if (o->op_type == OP_REFGEN)
+ op_null(cUNOPx(cUNOPo->op_first)->op_first); /* pushmark */
+ op_null(o);
+ return o;
}
/* [20011101.069] File test operators interpret OPf_REF to mean that
@@ -4410,16 +4565,16 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP
*last)
last->op_sibling = (OP*)binop;
#endif
- binop = (BINOP*)CHECKOP(type, binop);
- if (binop->op_next || binop->op_type != (OPCODE)type)
- return (OP*)binop;
-
binop->op_last = OP_SIBLING(binop->op_first);
#ifdef PERL_OP_PARENT
if (binop->op_last)
binop->op_last->op_sibling = (OP*)binop;
#endif
+ binop = (BINOP*)CHECKOP(type, binop);
+ if (binop->op_next || binop->op_type != (OPCODE)type)
+ return (OP*)binop;
+
return fold_constants(op_integerize(op_std_init((OP *)binop)));
}
@@ -5661,11 +5816,15 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP
*listval)
list(force_list(listval, 1)) );
}
+#define ASSIGN_LIST 1
+#define ASSIGN_REF 2
+
STATIC I32
-S_is_list_assignment(pTHX_ const OP *o)
+S_assignment_type(pTHX_ const OP *o)
{
unsigned type;
U8 flags;
+ U8 ret;
if (!o)
return TRUE;
@@ -5677,40 +5836,72 @@ S_is_list_assignment(pTHX_ const OP *o)
type = o->op_type;
if (type == OP_COND_EXPR) {
OP * const sib = OP_SIBLING(cLOGOPo->op_first);
- const I32 t = is_list_assignment(sib);
- const I32 f = is_list_assignment(OP_SIBLING(sib));
+ const I32 t = assignment_type(sib);
+ const I32 f = assignment_type(OP_SIBLING(sib));
- if (t && f)
- return TRUE;
- if (t || f)
+ if (t == ASSIGN_LIST && f == ASSIGN_LIST)
+ return ASSIGN_LIST;
+ if ((t == ASSIGN_LIST) ^ (f == ASSIGN_LIST))
yyerror("Assignment to both a list and a scalar");
return FALSE;
}
+ if (type == OP_SREFGEN)
+ {
+ OP * const kid = cUNOPx(cUNOPo->op_first)->op_first;
+ type = kid->op_type;
+ flags |= kid->op_flags;
+ if (!(flags & OPf_PARENS)
+ && (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV ||
+ kid->op_type == OP_RV2HV || kid->op_type == OP_PADHV ))
+ return ASSIGN_REF;
+ ret = ASSIGN_REF;
+ }
+ else ret = 0;
+
if (type == OP_LIST &&
(flags & OPf_WANT) == OPf_WANT_SCALAR &&
o->op_private & OPpLVAL_INTRO)
- return FALSE;
+ return ret;
if (type == OP_LIST || flags & OPf_PARENS ||
type == OP_RV2AV || type == OP_RV2HV ||
type == OP_ASLICE || type == OP_HSLICE ||
- type == OP_KVASLICE || type == OP_KVHSLICE)
+ type == OP_KVASLICE || type == OP_KVHSLICE || type == OP_REFGEN)
return TRUE;
if (type == OP_PADAV || type == OP_PADHV)
return TRUE;
if (type == OP_RV2SV)
- return FALSE;
+ return ret;
- return FALSE;
+ return ret;
}
/*
Helper function for newASSIGNOP to detection commonality between the
- lhs and the rhs. Marks all variables with PL_generation. If it
+ lhs and the rhs. (It is actually called very indirectly. newASSIGNOP
+ flags the op and the peephole optimizer calls this helper function
+ if the flag is set.) Marks all variables with PL_generation. If it
returns TRUE the assignment must be able to handle common variables.
+
+ PL_generation sorcery:
+ An assignment like ($a,$b) = ($c,$d) is easier than
+ ($a,$b) = ($c,$a), since there is no need for temporary vars.
+ To detect whether there are common vars, the global var
+ PL_generation is incremented for each assign op we compile.
+ Then, while compiling the assign op, we run through all the
+ variables on both sides of the assignment, setting a spare slot
+ in each of them to PL_generation. If any of them already have
+ that value, we know we've got commonality. Also, if the
+ generation number is already set to PERL_INT_MAX, then
+ the variable is involved in aliasing, so we also have
+ potential commonality in that case. We could use a
+ single bit marker, but then we'd have to make 2 passes, first
+ to clear the flag, then to test and set it. And that
+ wouldn't help with aliasing, either. To find somewhere
+ to store these values, evil chicanery is done with SvUVX().
*/
PERL_STATIC_INLINE bool
S_aassign_common_vars(pTHX_ OP* o)
@@ -5718,7 +5909,7 @@ S_aassign_common_vars(pTHX_ OP* o)
OP *curop;
for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
- if (curop->op_type == OP_GV) {
+ if (curop->op_type == OP_GV || curop->op_type == OP_GVSV) {
GV *gv = cGVOPx_gv(curop);
if (gv == PL_defgv
|| (int)GvASSIGN_GENERATION(gv) == PL_generation)
@@ -5731,7 +5922,8 @@ S_aassign_common_vars(pTHX_ OP* o)
curop->op_type == OP_PADANY)
{
if (PAD_COMPNAME_GEN(curop->op_targ)
- == (STRLEN)PL_generation)
+ == (STRLEN)PL_generation
+ || PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
return TRUE;
PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
@@ -5761,6 +5953,9 @@ S_aassign_common_vars(pTHX_ OP* o)
GvASSIGN_GENERATION_set(gv, PL_generation);
}
}
+ else if (curop->op_type == OP_PADRANGE)
+ /* Ignore padrange; checking its siblings is sufficient. */
+ continue;
else
return TRUE;
}
@@ -5773,6 +5968,29 @@ S_aassign_common_vars(pTHX_ OP* o)
return FALSE;
}
+/* This variant only handles lexical aliases. It is called when
+ newASSIGNOP decides that we donât have any common vars, as lexical ali-
+ ases trump that decision. */
+PERL_STATIC_INLINE bool
+S_aassign_common_vars_aliases_only(pTHX_ OP *o)
+{
+ OP *curop;
+ for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
+ if ((curop->op_type == OP_PADSV ||
+ curop->op_type == OP_PADAV ||
+ curop->op_type == OP_PADHV ||
+ curop->op_type == OP_PADANY)
+ && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
+ return TRUE;
+
+ if (curop->op_flags & OPf_KIDS) {
+ if (S_aassign_common_vars_aliases_only(aTHX_ curop))
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
/*
=for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right
@@ -5800,6 +6018,7 @@ OP *
Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
{
OP *o;
+ I32 assign_type;
if (optype) {
if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN || optype ==
OP_DORASSIGN) {
@@ -5813,7 +6032,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
}
}
- if (is_list_assignment(left)) {
+ if ((assign_type = assignment_type(left)) == ASSIGN_LIST) {
static const char no_list_state[] = "Initialization of state variables"
" in list context currently forbidden";
OP *curop;
@@ -5838,7 +6057,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
lop->op_type == OP_PADHV ||
lop->op_type == OP_PADANY) {
if (!(lop->op_private & OPpLVAL_INTRO))
+ {
maybe_common_vars = TRUE;
+ break;
+ }
if (lop->op_private & OPpPAD_STATE) {
if (left->op_private & OPpLVAL_INTRO) {
@@ -5860,6 +6082,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
} else {
/* Other ops in the list. */
maybe_common_vars = TRUE;
+ break;
}
lop = OP_SIBLING(lop);
}
@@ -5886,25 +6109,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
}
}
- /* PL_generation sorcery:
- * an assignment like ($a,$b) = ($c,$d) is easier than
- * ($a,$b) = ($c,$a), since there is no need for temporary vars.
- * To detect whether there are common vars, the global var
- * PL_generation is incremented for each assign op we compile.
- * Then, while compiling the assign op, we run through all the
- * variables on both sides of the assignment, setting a spare slot
- * in each of them to PL_generation. If any of them already have
- * that value, we know we've got commonality. We could use a
- * single bit marker, but then we'd have to make 2 passes, first
- * to clear the flag, then to test and set it. To find somewhere
- * to store these values, evil chicanery is done with SvUVX().
- */
-
if (maybe_common_vars) {
- PL_generation++;
- if (aassign_common_vars(o))
+ /* The peephole optimizer will do the full check and pos-
+ sibly turn this off. */
o->op_private |= OPpASSIGN_COMMON;
- LINKLIST(o);
}
if (right && right->op_type == OP_SPLIT) {
@@ -5912,8 +6120,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
PMOP * const pm = (PMOP*)tmpop;
if (left->op_type == OP_RV2AV &&
- !(left->op_private & OPpLVAL_INTRO) &&
- !(o->op_private & OPpASSIGN_COMMON) )
+ !(left->op_private & OPpLVAL_INTRO))
{
tmpop = ((UNOP*)left)->op_first;
if (tmpop->op_type == OP_GV
@@ -5937,7 +6144,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
/* detach rest of siblings from o subtree,
* and free subtree */
op_sibling_splice(cUNOPo->op_first, tmpop, -1, NULL);
- right->op_next = tmpop->op_next; /* fix starting loc */
right->op_private |=
left->op_private & OPpOUR_INTRO;
op_free(o); /* blow off assign */
@@ -5972,6 +6178,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
}
return o;
}
+ if (assign_type == ASSIGN_REF)
+ return newBINOP(OP_REFASSIGN, flags, scalar(right), left);
if (!right)
right = newOP(OP_UNDEF, 0);
if (right->op_type == OP_READLINE) {
@@ -6765,7 +6973,10 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP
*block, OP *cont)
sv->op_targ = 0;
op_free(sv);
sv = NULL;
+ PAD_COMPNAME_GEN_set(padoff, PERL_INT_MAX);
}
+ else if (sv->op_type == OP_NULL && sv->op_targ == OP_SREFGEN)
+ NOOP;
else
Perl_croak(aTHX_ "Can't use %s for loop variable",
PL_op_desc[sv->op_type]);
if (padoff) {
@@ -8867,9 +9078,14 @@ Perl_ck_spair(pTHX_ OP *o)
newop = OP_SIBLING(kidkid);
if (newop) {
const OPCODE type = newop->op_type;
- if (OP_HAS_SIBLING(newop) || !(PL_opargs[type] & OA_RETSCALAR) ||
- type == OP_PADAV || type == OP_PADHV ||
- type == OP_RV2AV || type == OP_RV2HV)
+ if (OP_HAS_SIBLING(newop))
+ return o;
+ if (o->op_type == OP_REFGEN && !(newop->op_flags & OPf_PARENS)
+ && (type == OP_RV2AV || type == OP_PADAV
+ || type == OP_RV2HV || type == OP_PADHV
+ || type == OP_RV2CV))
+ NOOP; /* OK (allow srefgen for \@a and \%h) */
+ else if (!(PL_opargs[type] & OA_RETSCALAR))
return o;
}
/* excise first sibling */
@@ -9759,23 +9975,18 @@ Perl_ck_sassign(pTHX_ OP *o)
OP *const first = newOP(OP_NULL, 0);
OP *const nullop = newCONDOP(0, first, o, other);
OP *const condop = first->op_next;
- /* hijacking PADSTALE for uninitialized state variables */
- SvPADSTALE_on(PAD_SVl(target));
condop->op_type = OP_ONCE;
condop->op_ppaddr = PL_ppaddr[OP_ONCE];
- condop->op_targ = target;
other->op_targ = target;
- /* Because we change the type of the op here, we will skip the
- assignment binop->op_last = OP_SIBLING(binop->op_first); at the
- end of Perl_newBINOP(). So need to do it here. */
- cBINOPo->op_last = OP_SIBLING(cBINOPo->op_first);
- cBINOPo->op_first->op_lastsib = 0;
- cBINOPo->op_last ->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
- cBINOPo->op_last->op_sibling = o;
-#endif
+ /* Store the initializedness of state vars in a separate
+ pad entry. */
+ condop->op_targ =
+ pad_add_name_pvn("$",1,padadd_NO_DUP_CHECK|padadd_STATE,0,0);
+ /* hijacking PADSTALE for uninitialized state variables */
+ SvPADSTALE_on(PAD_SVl(condop->op_targ));
+
return nullop;
}
}
@@ -9864,6 +10075,82 @@ Perl_ck_open(pTHX_ OP *o)
}
OP *
+Perl_ck_refassign(pTHX_ OP *o)
+{
+ OP * const right = cLISTOPo->op_first;
+ OP * const left = OP_SIBLING(right);
+ OP * const varop = cUNOPx(cUNOPx(left)->op_first)->op_first;
+ bool stacked = 0;
+
+ PERL_ARGS_ASSERT_CK_REFASSIGN;
+ assert (left);
+ assert (left->op_type == OP_SREFGEN);
+
+ switch (varop->op_type) {
+ case OP_PADAV:
+ o->op_private = OPpLVREF_AV;
+ goto settarg;
+ case OP_PADHV:
+ o->op_private = OPpLVREF_HV;
+ case OP_PADSV:
+ settarg:
+ o->op_targ = varop->op_targ;
+ varop->op_targ = 0;
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
+ break;
+ case OP_RV2AV:
+ o->op_private = OPpLVREF_AV;
+ goto checkgv;
+ case OP_RV2HV:
+ o->op_private = OPpLVREF_HV;
+ case OP_RV2SV:
+ checkgv:
+ if (cUNOPx(varop)->op_first->op_type != OP_GV) goto bad;
+ goto null_and_stack;
+ case OP_RV2CV: {
+ OP * const kid =
+ cUNOPx(cUNOPx(cUNOPx(varop)->op_first)->op_first->op_sibling)
+ ->op_first;
+ o->op_private = OPpLVREF_CV;
+ if (kid->op_type == OP_GV) goto null_and_stack;
+ if (kid->op_type != OP_PADCV) goto bad;
+ o->op_targ = kid->op_targ;
+ kid->op_targ = 0;
+ break;
+ }
+ case OP_AELEM:
+ case OP_HELEM:
+ o->op_private = OPpLVREF_ELEM;
+ null_and_stack:
+ op_null(varop);
+ op_null(left);
+ stacked = TRUE;
+ break;
+ default:
+ bad:
+ /* diag_listed_as: Can't modify %s in %s */
+ yyerror(Perl_form(aTHX_ "Can't modify reference to %s in scalar "
+ "assignment",
+ OP_DESC(varop)));
+ return o;
+ }
+ if (!FEATURE_LVREF_IS_ENABLED)
+ Perl_croak(aTHX_
+ "Experimental lvalue references not enabled");
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
+ "Lvalue references are experimental");
+ o->op_private |= varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE);
+ if (stacked) o->op_flags |= OPf_STACKED;
+ else {
+ o->op_flags &=~ OPf_STACKED;
+ op_sibling_splice(o, right, 1, NULL);
+ op_free(left);
+ }
+ return o;
+}
+
+OP *
Perl_ck_repeat(pTHX_ OP *o)
{
PERL_ARGS_ASSERT_CK_REPEAT;
@@ -9874,6 +10161,7 @@ Perl_ck_repeat(pTHX_ OP *o)
kids = op_sibling_splice(o, NULL, -1, NULL); /* detach all kids */
kids = force_list(kids, 1); /* promote them to a list */
op_sibling_splice(o, NULL, 0, kids); /* and add back */
+ if (cBINOPo->op_last == kids) cBINOPo->op_last = NULL;
}
else
scalar(o);
@@ -10544,7 +10832,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV
*namegv, SV *protosv)
case '&':
proto++;
arg++;
- if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
+ if (o3->op_type != OP_REFGEN && o3->op_type != OP_SREFGEN
+ && o3->op_type != OP_UNDEF)
bad_type_gv(arg,
arg == 1 ? "block or sub {}" : "sub {}",
namegv, 0, o3);
@@ -12249,6 +12538,21 @@ Perl_rpeep(pTHX_ OP *o)
}
break;
+ case OP_AASSIGN:
+ /* We do the common-vars check here, rather than in newASSIGNOP
+ (as formerly), so that all lexical vars that get aliased are
+ marked as such before we do the check. */
+ if (o->op_private & OPpASSIGN_COMMON) {
+ /* See the comment before S_aassign_common_vars concerning
+ PL_generation sorcery. */
+ PL_generation++;
+ if (!aassign_common_vars(o))
+ o->op_private &=~ OPpASSIGN_COMMON;
+ }
+ else if (S_aassign_common_vars_aliases_only(aTHX_ o))
+ o->op_private |= OPpASSIGN_COMMON;
+ break;
+
case OP_CUSTOM: {
Perl_cpeep_t cpeep =
XopENTRYCUSTOM(o, xop_peep);
diff --git a/opcode.h b/opcode.h
index c2ff500..8117fd9 100644
--- a/opcode.h
+++ b/opcode.h
@@ -527,6 +527,10 @@ EXTCONST char* const PL_op_name[] = {
"introcv",
"clonecv",
"padrange",
+ "refassign",
+ "lvref",
+ "lvrefslice",
+ "lvavref",
"freed",
};
#endif
@@ -914,6 +918,10 @@ EXTCONST char* const PL_op_desc[] = {
"private subroutine",
"private subroutine",
"list of private variables",
+ "lvalue ref assignment",
+ "lvalue ref assignment",
+ "lvalue ref assignment",
+ "lvalue array reference",
"freed op",
};
#endif
@@ -1315,6 +1323,10 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
Perl_pp_introcv,
Perl_pp_clonecv,
Perl_pp_padrange,
+ Perl_pp_refassign,
+ Perl_pp_lvref,
+ Perl_pp_lvrefslice,
+ Perl_pp_lvavref,
}
#endif
#ifdef PERL_PPADDR_INITED
@@ -1712,6 +1724,10 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_null, /* introcv */
Perl_ck_null, /* clonecv */
Perl_ck_null, /* padrange */
+ Perl_ck_refassign, /* refassign */
+ Perl_ck_null, /* lvref */
+ Perl_ck_null, /* lvrefslice */
+ Perl_ck_null, /* lvavref */
}
#endif
#ifdef PERL_CHECK_INITED
@@ -2103,6 +2119,10 @@ EXTCONST U32 PL_opargs[] = {
0x00000040, /* introcv */
0x00000040, /* clonecv */
0x00000040, /* padrange */
+ 0x00000240, /* refassign */
+ 0x00000b40, /* lvref */
+ 0x00000440, /* lvrefslice */
+ 0x00000b40, /* lvavref */
};
#endif
@@ -2111,6 +2131,7 @@ EXTCONST U32 PL_opargs[] = {
END_EXTERN_C
+#define OPpLVREF_SV 0x00
#define OPpARG1_MASK 0x01
#define OPpCOREARGS_DEREF1 0x01
#define OPpENTERSUB_INARGS 0x01
@@ -2131,6 +2152,7 @@ END_EXTERN_C
#define OPpEVAL_UNICODE 0x04
#define OPpFT_STACKED 0x04
#define OPpITER_REVERSED 0x04
+#define OPpLVREF_ELEM 0x04
#define OPpSLICEWARNING 0x04
#define OPpSORT_REVERSE 0x04
#define OPpTRANS_IDENTICAL 0x04
@@ -2141,6 +2163,7 @@ END_EXTERN_C
#define OPpEVAL_BYTES 0x08
#define OPpFT_STACKING 0x08
#define OPpITER_DEF 0x08
+#define OPpLVREF_ITER 0x08
#define OPpMAYBE_LVSUB 0x08
#define OPpREVERSE_INPLACE 0x08
#define OPpSORT_INPLACE 0x08
@@ -2162,6 +2185,7 @@ END_EXTERN_C
#define OPpEARLY_CV 0x20
#define OPpEVAL_RE_REPARSING 0x20
#define OPpHUSH_VMSISH 0x20
+#define OPpLVREF_AV 0x20
#define OPpOPEN_IN_CRLF 0x20
#define OPpSORT_QSORT 0x20
#define OPpTRANS_COMPLEMENT 0x20
@@ -2175,6 +2199,7 @@ END_EXTERN_C
#define OPpFLIP_LINENUM 0x40
#define OPpHINT_M_VMSISH_STATUS 0x40
#define OPpLIST_GUESSED 0x40
+#define OPpLVREF_HV 0x40
#define OPpMAYBE_TRUEBOOL 0x40
#define OPpMAY_RETURN_CONSTANT 0x40
#define OPpOPEN_OUT_RAW 0x40
@@ -2186,6 +2211,8 @@ END_EXTERN_C
#define OPpTRANS_GROWS 0x40
#define OPpDEREF 0x60
#define OPpDEREF_SV 0x60
+#define OPpLVREF_CV 0x60
+#define OPpLVREF_TYPE 0x60
#define OPpPADRANGE_COUNTMASK 0x7f
#define OPpASSIGN_CV_TO_GV 0x80
#define OPpCOREARGS_PUSHMARK 0x80
@@ -2227,6 +2254,7 @@ EXTCONST char PL_op_private_labels[] = {
'<','U','T','F','\0',
'>','U','T','F','\0',
'A','M','P','E','R','\0',
+ 'A','V','\0',
'B','A','R','E','\0',
'B','K','W','A','R','D','\0',
'B','O','O','L','\0',
@@ -2236,6 +2264,7 @@ EXTCONST char PL_op_private_labels[] = {
'C','O','M','P','L','\0',
'C','O','N','S','T','\0',
'C','O','P','H','H','\0',
+ 'C','V','\0',
'C','V','2','G','V','\0',
'D','B','G','\0',
'D','E','F','\0',
@@ -2248,6 +2277,7 @@ EXTCONST char PL_op_private_labels[] = {
'D','R','E','F','H','V','\0',
'D','R','E','F','S','V','\0',
'E','A','R','L','Y','C','V','\0',
+ 'E','L','E','M','\0',
'E','N','T','E','R','E','D','\0',
'F','A','K','E','\0',
'F','T','A','C','C','E','S','S','\0',
@@ -2259,6 +2289,7 @@ EXTCONST char PL_op_private_labels[] = {
'G','U','E','S','S','E','D','\0',
'H','A','S','_','H','H','\0',
'H','U','S','H','\0',
+ 'H','V','\0',
'I','D','E','N','T','\0',
'I','M','P','L','I','M','\0',
'I','N','A','R','G','S','\0',
@@ -2266,6 +2297,7 @@ EXTCONST char PL_op_private_labels[] = {
'I','N','C','R','\0',
'I','N','P','L','A','C','E','\0',
'I','N','T','\0',
+ 'I','T','E','R','\0',
'L','I','N','E','N','U','M','\0',
'L','V','\0',
'L','V','D','E','F','E','R','\0',
@@ -2294,6 +2326,7 @@ EXTCONST char PL_op_private_labels[] = {
'S','T','A','T','E','\0',
'S','T','R','I','C','T','\0',
'S','U','B','\0',
+ 'S','V','\0',
'T','A','R','G','\0',
'T','A','R','G','M','Y','\0',
'U','N','I','\0',
@@ -2322,7 +2355,8 @@ EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
0, 8, -1,
- 5, -1, 1, 124, 2, 131, 3, 138, -1,
+ 5, -1, 1, 130, 2, 137, 3, 144, -1,
+ 5, -1, 0, 481, 1, 26, 2, 250, 3, 83, -1,
};
@@ -2710,6 +2744,10 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
-1, /* introcv */
-1, /* clonecv */
630, /* padrange */
+ 632, /* refassign */
+ 638, /* lvref */
+ 644, /* lvrefslice */
+ 645, /* lvavref */
};
@@ -2729,71 +2767,71 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
EXTCONST U16 PL_op_private_bitdefs[] = {
/* scalar */ 0x0003,
- /* pushmark */ 0x25bc, 0x37b1,
+ /* pushmark */ 0x281c, 0x3a11,
/* wantarray */ 0x00bd,
- /* const */ 0x0358, 0x1330, 0x386c, 0x3328, 0x2985,
- /* gvsv */ 0x25bc, 0x2ad1,
- /* gv */ 0x1235,
+ /* const */ 0x03b8, 0x1490, 0x3acc, 0x3588, 0x2be5,
+ /* gvsv */ 0x281c, 0x2d31,
+ /* gv */ 0x12f5,
/* gelem */ 0x0067,
- /* padsv */ 0x25bc, 0x025a, 0x37b1,
- /* padav */ 0x25bc, 0x37b0, 0x26ac, 0x34a9,
- /* padhv */ 0x25bc, 0x0578, 0x04d4, 0x37b0, 0x26ac, 0x34a9,
- /* pushre */ 0x3279,
- /* rv2gv */ 0x25bc, 0x025a, 0x1430, 0x26ac, 0x28a8, 0x3864, 0x0003,
- /* rv2sv */ 0x25bc, 0x025a, 0x2ad0, 0x3864, 0x0003,
- /* av2arylen */ 0x26ac, 0x0003,
- /* rv2cv */ 0x281c, 0x0898, 0x0ad0, 0x028c, 0x39c8, 0x3864, 0x0003,
+ /* padsv */ 0x281c, 0x025a, 0x3a11,
+ /* padav */ 0x281c, 0x3a10, 0x290c, 0x3709,
+ /* padhv */ 0x281c, 0x05d8, 0x0534, 0x3a10, 0x290c, 0x3709,
+ /* pushre */ 0x34d9,
+ /* rv2gv */ 0x281c, 0x025a, 0x1590, 0x290c, 0x2b08, 0x3ac4, 0x0003,
+ /* rv2sv */ 0x281c, 0x025a, 0x2d30, 0x3ac4, 0x0003,
+ /* av2arylen */ 0x290c, 0x0003,
+ /* rv2cv */ 0x2a7c, 0x08f8, 0x0b90, 0x028c, 0x3c88, 0x3ac4, 0x0003,
/* prototype */ 0x0003,
/* refgen */ 0x0003,
/* srefgen */ 0x0003,
/* ref */ 0x0003,
/* bless */ 0x012f,
- /* backtick */ 0x2cbc, 0x2bd8, 0x2134, 0x2070, 0x0003,
+ /* backtick */ 0x2f1c, 0x2e38, 0x22f4, 0x2230, 0x0003,
/* glob */ 0x012f,
/* readline */ 0x0003,
/* regcmaybe */ 0x0003,
/* regcreset */ 0x0003,
/* regcomp */ 0x0003,
- /* match */ 0x3278, 0x3a71,
- /* qr */ 0x3279,
- /* subst */ 0x3278, 0x3a71,
- /* substcont */ 0x3278, 0x0003,
- /* trans */ 0x0bdc, 0x1ab8, 0x07d4, 0x3a70, 0x35ec, 0x1de8,
0x01e4, 0x0141,
- /* transr */ 0x0bdc, 0x1ab8, 0x07d4, 0x3a70, 0x35ec, 0x1de8,
0x01e4, 0x0141,
- /* sassign */ 0x0a1c, 0x03f8, 0x0067,
- /* aassign */ 0x06f8, 0x26ac, 0x0067,
+ /* match */ 0x34d8, 0x3d31,
+ /* qr */ 0x34d9,
+ /* subst */ 0x34d8, 0x3d31,
+ /* substcont */ 0x34d8, 0x0003,
+ /* trans */ 0x0c9c, 0x1c18, 0x0834, 0x3d30, 0x384c, 0x1fa8,
0x01e4, 0x0141,
+ /* transr */ 0x0c9c, 0x1c18, 0x0834, 0x3d30, 0x384c, 0x1fa8,
0x01e4, 0x0141,
+ /* sassign */ 0x0adc, 0x0458, 0x0067,
+ /* aassign */ 0x0758, 0x290c, 0x0067,
/* chop */ 0x0003,
/* schop */ 0x0003,
- /* chomp */ 0x3a70, 0x0003,
- /* schomp */ 0x3a70, 0x0003,
**** PATCH TRUNCATED AT 2000 LINES -- 6196 NOT SHOWN ****
--
Perl5 Master Repository
