set_up_inc("../lib");
}
-plan 111;
-
-sub on { $::TODO = ' ' }
-sub off{ $::TODO = '' }
+plan 156;
eval '\$x = \$y';
-like $@, qr/^Experimental lvalue references not enabled/,
+like $@, qr/^Experimental aliasing via reference not enabled/,
'error when feature is disabled';
eval '\($x) = \$y';
-like $@, qr/^Experimental lvalue references not enabled/,
+like $@, qr/^Experimental aliasing via reference not enabled/,
'error when feature is disabled (aassign)';
-use feature 'lvalue_refs';
+use feature 'refaliasing', 'state';
{
my($w,$c);
local $SIG{__WARN__} = sub { $c++; $w = shift };
eval '\$x = \$y';
is $c, 1, 'one warning from lv ref assignment';
- like $w, qr/^Lvalue references are experimental/,
+ like $w, qr/^Aliasing via reference is experimental/,
'experimental warning';
undef $c;
eval '\($x) = \$y';
is $c, 1, 'one warning from lv ref list assignment';
- like $w, qr/^Lvalue references are experimental/,
+ like $w, qr/^Aliasing via reference is experimental/,
'experimental warning';
}
-no warnings 'experimental::lvalue_refs';
+no warnings 'experimental::refaliasing';
# Scalars
-eval '\$x = \$y';
+\$x = \$y;
is \$x, \$y, '\$pkg_scalar = ...';
my $m;
\$m = \$y;
is $l, undef, 'localisation unwound';
\$foo = \*bar;
is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
+for (1,2) {
+ \my $x = \3,
+ \my($y) = \3,
+ \state $a = \3,
+ \state($b) = \3 if $_ == 1;
+ if ($_ == 2) {
+ is $x, undef, '\my $x = ... clears $x on scope exit';
+ is $y, undef, '\my($x) = ... clears $x on scope exit';
+ is $a, 3, '\state $x = ... does not clear $x on scope exit';
+ is $b, 3, '\state($x) = ... does not clear $x on scope exit';
+ }
+}
# Array Elements
\($h{b}) = expect_list_cx;
is \$h{b}, \$_, '\($hash{a})';
{
- my @h;
+ my %h;
\$h{a} = expect_scalar_cx;
is \$h{a}, \$_, '\$lexical_array{a}';
\($h{b}) = expect_list_cx;
is \$h{b}, \$_, '\local $h{a} unwound';
}
{
- my @h;
+ my %h;
\@h{"a","b"} = expect_list_cx;
is \$h{a}.\$h{b}, \$_.\$_, '\@hash{indices}';
\(@h{2,3}) = expect_list_cx;
sub expect_scalar_cx { wantarray ? 0 : \@ThatArray }
sub expect_list_cx { wantarray ? (\$_,\$_) : 0 }
sub expect_list_cx_a { wantarray ? (\@ThatArray)x2 : 0 }
- eval '\@a = expect_scalar_cx';
+ \@a = expect_scalar_cx;
is \@a, \@ThatArray, '\@pkg';
my @a;
\@a = expect_scalar_cx;
}
is \@h, $old, '\local @a unwound';
$old = \@i;
- eval q{
+ {
(\local @i) = \@ThatArray;
is \@i, \@ThatArray, '(\local @a)';
- } or do { SKIP: { ::skip 'unimplemented' } };
+ }
is \@i, $old, '(\local @a) unwound';
}
+for (1,2) {
+ \my @x = [1..3],
+ \my(@y) = \3,
+ \state @a = [1..3],
+ \state(@b) = \3 if $_ == 1;
+ if ($_ == 2) {
+ is @x, 0, '\my @x = ... clears @x on scope exit';
+ is @y, 0, '\my(@x) = ... clears @x on scope exit';
+ is "@a", "1 2 3", '\state @x = ... does not clear @x on scope exit';
+ is "@b", 3, '\state(@x) = ... does not clear @x on scope exit';
+ }
+}
# Hashes
}
is \%h, $old, '\local %a unwound';
$old = \%i;
- eval q{
+ {
(\local %i) = \%ThatHash;
is \%i, \%ThatHash, '(\local %a)';
- } or do { SKIP: { ::skip 'unimplemented' } };
+ }
is \%i, $old, '(\local %a) unwound';
}
+for (1,2) {
+ \state %y = {1,2},
+ \my %x = {1,2} if $_ == 1;
+ if ($_ == 2) {
+ is %x, 0, '\my %x = ... clears %x on scope exit';
+ is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit';
+ }
+}
# Subroutines
-# ...
+package CodeTest {
+ BEGIN { *is = *main::is; }
+ use feature 'lexical_subs';
+ no warnings 'experimental::lexical_subs';
+ sub expect_scalar_cx { wantarray ? 0 : \&ThatSub }
+ sub expect_list_cx { wantarray ? (\&ThatSub)x2 : 0 }
+ \&a = expect_scalar_cx;
+ is \&a, \&ThatSub, '\&pkg';
+ my sub a;
+ \&a = expect_scalar_cx;
+ is \&a, \&ThatSub, '\&mysub';
+ state sub as;
+ \&as = expect_scalar_cx;
+ is \&as, \&ThatSub, '\&statesub';
+ (\&b) = expect_list_cx;
+ is \&b, \&ThatSub, '(\&pkg)';
+ my sub b;
+ (\&b) = expect_list_cx;
+ is \&b, \&ThatSub, '(\&mysub)';
+ my sub bs;
+ (\&bs) = expect_list_cx;
+ is \&bs, \&ThatSub, '(\&statesub)';
+ \(&c) = expect_list_cx;
+ is \&c, \&ThatSub, '\(&pkg)';
+ my sub b;
+ \(&c) = expect_list_cx;
+ is \&c, \&ThatSub, '\(&mysub)';
+ my sub bs;
+ \(&cs) = expect_list_cx;
+ is \&cs, \&ThatSub, '\(&statesub)';
+}
# Mixed List Assignments
(\$tahi, $rua) = \(1,2);
is join(' ', $tahi, $$rua), '1 2',
'mixed scalar ref and scalar list assignment';
+$_ = 1;
+\($bb, @cc, %dd, &ee, $_==1 ? $ff : @ff, $_==2 ? $gg : @gg, (@hh)) =
+ (\$BB, \@CC, \%DD, \&EE, \$FF, \@GG, \1, \2, \3);
+is \$bb, \$BB, '\$scalar in list assignment';
+is \@cc, \@CC, '\@array in list assignment';
+is \%dd, \%DD, '\%hash in list assignment';
+is \&ee, \&EE, '\&code in list assignment';
+is \$ff, \$FF, '$scalar in \ternary in list assignment';
+is \@gg, \@GG, '@gg in \ternary in list assignment';
+is "@hh", '1 2 3', '\(@array) in list assignment';
# Conditional expressions
is $rima, 5, 'cond assignment with refgens on both branches';
\($_ == 3 ? $whitu : $waru) = \5;
is $whitu, 5, '\( ?: ) assignment';
+\($_ == 3 ? $_ < 4 ? $ii : $_ : $_) = \$_;
+is \$ii, \$_, 'nested \ternary assignment';
# Foreach
-on;
-eval '
- for \my $a(\$for1, \$for2) {
- push @for, \$a;
- }
-';
+for \my $topic (\$for1, \$for2) {
+ push @for, \$topic;
+}
is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
+is \$topic, \$::topic, 'for \my scoping';
@for = ();
-eval '
- for \my @a([1,2], [3,4]) {
+for \$::a(\$for1, \$for2) {
+ push @for, \$::a;
+}
+is "@for", \$for1 . ' ' . \$for2, 'foreach \$::a';
+
+@for = ();
+for \my @a([1,2], [3,4]) {
push @for, @a;
- }
-';
+}
is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
@for = ();
-eval '
- for \my %a({5,6}, {7,8}) {
+for \@::a([1,2], [3,4]) {
+ push @for, @::a;
+}
+is "@for", "1 2 3 4", 'foreach \@::a [perl #22335]';
+
+@for = ();
+for \my %a({5,6}, {7,8}) {
push @for, %a;
- }
-';
+}
is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
@for = ();
-eval '
- for \my &a(sub {9}, sub {10}) {
+for \%::a({5,6}, {7,8}) {
+ push @for, %::a;
+}
+is "@for", "5 6 7 8", 'foreach \%::a [perl #22335]';
+
+@for = ();
+{
+ use feature 'lexical_subs';
+ no warnings 'experimental::lexical_subs';
+ my sub a;
+ for \&a(sub {9}, sub {10}) {
push @for, &a;
}
-';
-is "@for", "9 10", 'foreach \my &a';
+}
+is "@for", "9 10", 'foreach \&padcv';
+@for = ();
+for \&::a(sub {9}, sub {10}) {
+ push @for, &::a;
+}
+is "@for", "9 10", 'foreach \&rv2cv';
# Errors
-off;
eval { my $x; \$x = 3 };
like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
eval { my $x; \$x = [] };
eval { \%::x = [] };
like $@, qr/^Assigned value is not a HASH reference at/,
'assigning non-hash ref to package hash ref';
+eval { use feature 'lexical_subs';
+ no warnings 'experimental::lexical_subs';
+ my sub x; \&x = [] };
+like $@, qr/^Assigned value is not a CODE reference at/,
+ 'assigning non-code ref to lexical code ref';
+eval { \&::x = [] };
+like $@, qr/^Assigned value is not a CODE reference at/,
+ 'assigning non-code ref to package code ref';
eval { my $x; (\$x) = 3 };
like $@, qr/^Assigned value is not a reference at/,
eval { (\%::x) = [] };
like $@, qr/^Assigned value is not a HASH reference at/,
'list-assigning non-hash ref to package hash ref';
+eval { use feature 'lexical_subs';
+ no warnings 'experimental::lexical_subs';
+ my sub x; (\&x) = [] };
+like $@, qr/^Assigned value is not a CODE reference at/,
+ 'list-assigning non-code ref to lexical code ref';
+eval { (\&::x) = [] };
+like $@, qr/^Assigned value is not a CODE reference at/,
+ 'list-assigning non-code ref to package code ref';
eval '(\do{}) = 42';
like $@, qr/^Can't modify reference to do block in list assignment at /,
like $@,
qr/^Can't modify reference to hash dereference in scalar assignment a/,
"Can't modify reference to hash dereference in scalar assignment";
-on;
-
+eval '$foo ? \%{"42"} : \%43 = 42';
+like $@,
+ qr/^Can't modify reference to hash dereference in scalar assignment a/,
+ "Can't modify ref to whatever in scalar assignment via cond expr";
+eval '\$0=~y///=0';
+like $@,
+ qr#^Can't modify transliteration \(tr///\) in scalar assignment a#,
+ "Can't modify transliteration (tr///) in scalar assignment";
# Miscellaneous
{
+ local $::TODO = ' ';
my($x,$y);
sub {
sub {
}
{ # PADSTALE has a double meaning
- use feature 'lexical_subs', 'signatures', 'state';
+ use feature 'lexical_subs', 'signatures';
no warnings 'experimental';
my $c;
my sub s ($arg) {
is s(3), 1, 'padstale alias should not reset state'
}
-off;
SKIP: {
skip_without_dynamic_extension('List/Util');
require Scalar::Util;
\$a = $r;
pass 'no crash when assigning \$lex = $weakref_to_lex'
}
+
+{
+ \my $x = \my $y;
+ $x = 3;
+ ($x, my $z) = (1, $y);
+ is $z, 3, 'list assignment after aliasing lexical scalars';
+}
+{
+ (\my $x) = \my $y;
+ $x = 3;
+ ($x, my $z) = (1, $y);
+ is $z, 3,
+ 'regular list assignment after aliasing via list assignment';
+}
+{
+ my $y;
+ goto do_aliasing;
+
+ do_test:
+ $y = 3;
+ my($x,$z) = (1, $y);
+ is $z, 3, 'list assignment "before" aliasing lexical scalars';
+ last;
+
+ do_aliasing:
+ \$x = \$y;
+ goto do_test;
+}
+{
+ my $y;
+ goto do_aliasing2;
+
+ do_test2:
+ $y = 3;
+ my($x,$z) = (1, $y);
+ is $z, 3,
+ 'list assignment "before" aliasing lex scalars via list assignment';
+ last;
+
+ do_aliasing2:
+ \($x) = \$y;
+ goto do_test2;
+}
+{
+ my @a;
+ goto do_aliasing3;
+
+ do_test3:
+ @a[0,1] = qw<a b>;
+ my($y,$x) = ($a[0],$a[1]);
+ is "@a", 'b a',
+ 'aelemfast_lex-to-scalar list assignment "before" aliasing';
+ last;
+
+ do_aliasing3:
+ \(@a) = \($x,$y);
+ goto do_test3;
+}
+
+# Used to fail an assertion [perl #123821]
+eval '\(&$0)=0';
+pass("RT #123821");
+
+# Used to fail an assertion [perl #128252]
+{
+ no feature 'refaliasing';
+ use warnings;
+ eval q{sub{\@0[0]=0};};
+ pass("RT #128252");
+}