use v6-alpha;
use Test;
# L<S03/"Changes to Perl 5 operators"/"The list assignment operator now parses on the right">
plan 208;
# tests various assignment styles
{
my ($foo, $bar) = ("FOO", "BAR");
is($foo, "FOO", "assigned correct value to first of two scalars");
is($bar, "BAR", "... and second");
($foo, $bar) = ($bar, $foo);
is($foo, "BAR", "swap assignment works for the first value");
is($bar, "FOO", "... and second");
}
{
my $x = 1;
&infix:<=>.($x, 0);
is($x, 0, 'assignment operator called as function');
}
{
# swap two elements in the same array
# (moved this from array.t)
my @a = (1 .. 5);
@a[0,1] = @a[1,0];
is(@a[0], 2, "slice assignment swapping two element in the same array");
is(@a[1], 1, "slice assignment swapping two element in the same array");
}
{
# swap two elements as slice, dwim slice from @b subscript
my @a = (1 .. 2);
my @b = (0 .. 2);
@a[@b] = @a[1, 0], 3;
is(@a[0], 2, "slice assignment swapping with array dwim");
is(@a[1], 1, "slice assignment swapping with array dwim");
is(@a[2], 3, "slice assignment swapping with array dwim makes listop");
}
{
# list assignments
my @a = (1 .. 3);
my ($one, $two, $three) = @a;
is($one, 1, "list assignment my ($, $, $) = @ works");
is($two, 2, "list assignment my ($, $, $) = @ works");
is($three, 3, "list assignment my ($, $, $) = @ works");
}
{
# testing list assignment syntax
my ($a,$b,$c,@a);
($a,$b,$c) = 1 .. 3;
@a = 1 .. 3;
my ($s,@b) = 1 .. 3;
is($a,1,"'$a' is '1'?: ($,$,$) = 1 .. 3");
is($b,2,"'$b' is '2'?: ($,$,$) = 1 .. 3");
is($c,3,"'$c' is '3'?: ($,$,$) = 1 .. 3");
is(@a,'1 2 3',"'{@a}' is '1 2 3'?: @a = 1 .. 3");
is($s,'1', "$s is '1'?: my ($s,@a) = 1 .. 3");
is(@b,'2 3',"'{@b}' is '2 3'?: my ($s,@a) = 1 .. 3");
}
{
my @a;
@a[1, 2, 3] = 100, 200, 300;
is(@a[1], 100, "assigned correct value from list to sliced array");
is(@a[2], 200, "... and second");
is(@a[3], 300, "... and third");
is(@a[0], undef, "won't modify unassigned one");
my @b;
(@b[2, 1, 0]) = 401, 201, 1;
is(@b[0], 1, "assigned correct value from list to unsorted sliced array");
is(@b[1], 201, "... and second");
is(@b[2], 401, "... and third");
my @c;
my @d;
(@c[1, 2], @c[3], @d) = 100, 200, 300, 400, 500;
is(@c[1], 100, "assigned correct value from list to slice-in-list");
is(@c[2], 200, "... and second");
is(@c[3], 300, "... and third", :todo<feature>);
is(@d[0], 400, "... and fourth", :todo<feature>);
is(@d[1], 500, "... and fifth", :todo<feature>);
is(@c[0], undef, "won't modify unassigned one");
}
{
# chained @array = %hash = list assignment
my (@a, @b, %h);
@a = %h = (1,2);
@b = %h;
is(@a[0], @b[0], "chained @ = % = list assignment");
is(@a[1], @b[1], "chained @ = % = list assignment");
}
{
# chained $scalar = %hash = list assignment
my ($s, $t, %h);
$s = %h = (1,2);
$t = %h;
is($s, $t, "chained $ = % = list assignment");
}
{
# (@b, @a) = (@a, @b) assignment
my (@a, @b);
@a = (1);
@b = (2);
(@b, @a) = (@a, @b);
is(@a[0], undef, "(@b, @a) = (@a, @b) assignment \@a[0] == undef");
is(@b[0], 1, "(@b, @a) = (@a, @b) assignment \@b[0]");
is(@b[1], 2, "(@b, @a) = (@a, @b) assignment \@b[1]");
}
{
# (@b, @a) = @a, @b assignment
my (@a, @b);
@a = (1);
@b = (2);
(@b, @a) = @a, @b;
is(@a[0], undef, "(@b, @a) = @a, @b assignment \@a[0] == undef");
is(@b[0], 1, "(@b, @a) = @a, @b assignment \@b[0]");
is(@b[1], 2, "(@b, @a) = @a, @b assignment \@b[1]");
}
{
my $a;
$a ||= 3;
is($a,3, "||= operator");
$a ||= 10;
is($a,3, "... and second");
}
{
my $a;
$a //= 3;
is($a, 3, "//= operator");
$a //= 10;
is($a, 3, "... and second");
my %hash;
%hash<foo> //= hash();
is(WHAT %hash<foo>, 'Hash', "Verify //= autovivifies correctly");
}
{
my $a = 3;
$a &&= 42;
is($a, 42, "&&= operator");
$a = 0;
$a &&= 10;
is($a, 0, "... and second");
}
{
my $c;
(($c = 3) = 4);
is($c, 4, '(($c = 3) = 4) return val should be good as an lval');
}
{
my $x = 42;
$x += 6;
is($x, 48, '+= operator');
}
{
my $x = 42;
$x -= 6;
is($x, 36, '-= operator');
}
{
my $x = 4;
$x *= 3;
is($x, 12, '*= operator');
}
{
my $x = 6;
$x /= 3;
is($x, 2, '/= operator');
}
{
my $x = 2;
$x **= 3;
is($x, 8, '**= operator');
}
{
my $x = "abc";
$x ~= "yz";
is($x, 'abcyz', '~= operator');
}
{
my $x = "abc";
$x x= 3;
is($x, 'abcabcabc', 'x= operator');
}
{
my @x = ( 'a', 'z' );
@x xx= 3;
is(+@x, 6, 'xx= operator elems');
is(@x[0], 'a', 'xx= operator 0');
is(@x[1], 'z', 'xx= operator 1');
is(@x[2], 'a', 'xx= operator 2');
is(@x[3], 'z', 'xx= operator 3');
is(@x[4], 'a', 'xx= operator 4');
is(@x[5], 'z', 'xx= operator 5');
}
{
my $x = 1;
$x +&= 2;
is($x, 0, '+&= operator');
}
{
my $x = 1;
$x +|= 2;
is($x, 3, '+|= operator');
}
{
my $x = "z";
$x ~&= "I";
is($x, 'H', '~&= operator');
}
{
my $x = "z";
$x ~|= "I";
is($x, '{', '~|= operator');
}
{
my $x = 4;
$x %= 3;
is($x, 1, '%= operator');
}
{
my $x = 1;
$x +^= 3;
is($x, 2, '+^= operator');
}
{
my $x = "z";
$x ~^= "C";
is($x, 9, '~^= operator');
}
{
my $x = 0;
$x ^^= 42;
is($x, 42, '^^= operator');
}
{
my $x = 42;
$x ?|= 24;
is($x, 1, '?|= operator');
}
{
my $x = 42;
eval '$x ?&= 24'; # XXX: compiler blows up
is($x, 1, '?&= operator', :todo);
}
{
my $x = 0;
eval '$x ?^= 42'; # XXX: compiler blows up
is($x, 1, '?^= operator', :todo);
}
{
my $x = 1;
eval '$x +<= 8'; # XXX: compiler blows up
is($x, 256, '+<= operator', :todo);
}
{
my $x = 511;
eval '$x +>= 8'; # XXX: compiler blows up
is($x, 1, '+>= operator', :todo);
}
# XXX: The following tests assume autoconvertion between "a" and buf8 type
{
my $x = "a";
eval '$x ~<= 8'; # XXX: compiler blows up
is($x, "a\0", '~<= operator', :todo);
}
{
my $x = "aa";
eval '$x ~>= 8'; # XXX: compiler blows up
is($x, "a", '~>= operator', :todo);
}
# Tests of dwimming scalar/listiness of lhs
my sub W () { substr(want, 0, 1) }
{
my $a;
my @z = ($a = W, W);
is($a, 'S', 'lhs dwims $a as scalar');
is(@z[0], 'S', 'lhs dwims $a as scalar');
is(@z[1], 'L', 'lhs dwims $a as scalar');
}
{
my $a;
my @z = (($a) = W, W, W);
is($a, 'L', 'lhs dwims ($a) as list - i.e. emulate as ($a,)');
is(@z, "L", 'lhs dwims ($a) as list - i.e. emulate as ($a,)');
}
{
my $a;
my $b;
my @z = (($a,$b) = W, W, W);
is($a, 'L', 'lhs dwims ($a,$b) as list');
is($b, 'L', 'lhs dwims ($a,$b) as list');
is(@z, "L L", 'lhs dwims ($a,$b) as list');
}
{
my @a;
my @z = (@a[0] = W, W);
is(@a, 'S', 'lhs dwims @a[0] as scalar');
is(@z[0], 'S', 'lhs dwims @a[0] as scalar');
is(@z[1], 'L', 'lhs dwims @a[0] as scalar');
}
{
my @a;
my @z = (@a[0,] = W, W);
is(@a, 'L', 'lhs dwims @a[0,] as list');
is(@z[0], 'L', 'lhs dwims @a[0,] as list');
is(@z[1], undef, 'lhs dwims @a[0,] as list');
}
{
my %a;
my @z = (%a<x> = W, W);
is(%a{"x"}, 'S', 'lhs dwims %a<x> as scalar');
is(@z[0], 'S', 'lhs dwims %a<x> as scalar');
is(@z[1], 'L', 'lhs dwims %a<x> as scalar');
}
{
my %a;
my @z = (%a<x y z> = W, W, W);
is(%a<x>, 'L', 'lhs dwims %a<x y z> as list');
is(%a<y>, 'L', 'lhs dwims %a<x y z> as list');
is(%a<z>, 'L', 'lhs dwims %a<x y z> as list');
}
{
my %a;
my @z = (%a{'x'} = W, W);
is(%a{"x"}, 'S', q/lhs dwims %a{'x'} as scalar/);
is(@z[0], 'S', q/lhs dwims %a{'x'} as scalar/);
is(@z[1], 'L', q/lhs dwims %a{'x'} as scalar/);
}
{
my %a;
my @z = (%a{'x','y','z'} = W, W, W);
is(%a<x>, 'L', q/lhs dwims %a{'x','y','z'} as list/);
is(%a<y>, 'L', q/lhs dwims %a{'x','y','z'} as list/);
is(%a<z>, 'L', q/lhs dwims %a{'x','y','z'} as list/);
}
{
my %a;
my @z = (%a{'x'..'z'} = W, W, W);
is(%a<x>, 'L', q/lhs dwims %a{'x'..'z'} as list/);
is(%a<y>, 'L', q/lhs dwims %a{'x'..'z'} as list/);
is(%a<z>, 'L', q/lhs dwims %a{'x'..'z'} as list/);
}
{
my %a;
my @z = (%a{'x' x 1} = W, W);
is(%a{"x"}, 'S', q/lhs dwims %a{'x' x 1} as scalar/);
is(@z[0], 'S', q/lhs dwims %a{'x' x 1} as scalar/);
is(@z[1], 'L', q/lhs dwims %a{'x' x 1} as scalar/);
}
{
my %a;
my @z = (%a{'x' xx 1} = W, W, W);
is(%a<x>, 'L', q/lhs dwims %a{'x' xx 1} as list/);
is(@z[0], 'L', q/lhs dwims %a{'x' xx 1} as list/);
is(@z[1], undef, q/lhs dwims %a{'x' xx 1} as list/);
}
{
my @a;
my $b = 0;
my @z = (@a[$b] = W, W);
is(@a, 'S', 'lhs dwims @a[$b] as scalar');
is(@z[0], 'S', 'lhs dwims @a[$b] as scalar');
is(@z[1], 'L', 'lhs dwims @a[$b] as scalar');
}
{
my @a;
my $b = 0;
my @z = (@a[$b,] = W, W);
is(@a, 'L', 'lhs dwims @a[$b,] as list');
is(@z[0], 'L', 'lhs dwims @a[$b,] as list');
is(@z[1], undef, 'lhs dwims @a[$b,] as list');
}
{
my @a;
my @b = (0,1);
my @z = (@a[@b] = W, W, W);
is(@a, 'L L', 'lhs dwims @a[@b] as list');
is(@z[0], 'L', 'lhs dwims @a[@b] as list');
is(@z[1], 'L', 'lhs dwims @a[@b] as list');
is(@z[2], undef, 'lhs dwims @a[@b] as list');
}
{
my @a;
my @b = (0,0);
my $c = 1;
my @z = (@a[@b[$c]] = W, W);
is(@a, 'S', 'lhs dwims @a[@b[$c]] as scalar');
is(@z[0], 'S', 'lhs dwims @a[@b[$c]] as scalar');
is(@z[1], 'L', 'lhs dwims @a[@b[$c]] as scalar');
}
{
my @a;
my @b = (0,0);
my $c = 1;
my @z = (@a[@b[$c,]] = W, W);
is(@a, 'L', 'lhs dwims @a[@b[$c,]] as list');
is(@z[0], 'L', 'lhs dwims @a[@b[$c,]] as list');
is(@z[1], undef, 'lhs dwims @a[@b[$c,]] as list');
}
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = eval '(foo()[$b] = W, W)';
is(@a, 'S', 'lhs dwims foo()[$b] as scalar');
is(@z[0], 'S', 'lhs dwims foo()[$b] as scalar');
is(@z[1], 'L', 'lhs dwims foo()[$b] as scalar');
}
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = eval '(foo()[$b,] = W, W)';
is(@a, 'L', 'lhs dwims foo()[$b,] as list');
is(@z[0], 'L', 'lhs dwims foo()[$b,] as list');
is(@z[1], undef, 'lhs dwims foo()[$b,] as list');
}
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = (@a[foo()[$b]] = W, W);
is(@a, 'S', 'lhs dwims @a[foo()[$b]] as scalar');
is(@z[0], 'S', 'lhs dwims @a[foo()[$b]] as scalar');
is(@z[1], 'L', 'lhs dwims @a[foo()[$b]] as scalar');
}
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = (@a[foo()[$b,]] = W, W);
is(@a, 'L', 'lhs dwims @a[foo()[$b,]] as list');
is(@z[0], 'L', 'lhs dwims @a[foo()[$b,]] as list');
is(@z[1], undef, 'lhs dwims @a[foo()[$b,]] as list');
}
{
my @a;
my sub foo { 0 }
my @z = (@a[+foo()] = W, W);
is(@a, 'S', 'lhs dwims @a[+foo()] as scalar');
is(@z[0], 'S', 'lhs dwims @a[+foo()] as scalar');
is(@z[1], 'L', 'lhs dwims @a[+foo()] as scalar');
}
{
my @a;
my sub foo { '0' }
my @z = (@a[~foo()] = W, W);
is(@a, 'S', 'lhs dwims @a[~foo()] as scalar');
is(@z[0], 'S', 'lhs dwims @a[~foo()] as scalar');
is(@z[1], 'L', 'lhs dwims @a[~foo()] as scalar');
}
{
my @a;
my sub foo { 0 }
my @z = (@a[?foo()] = W, W);
is(@a, 'S', 'lhs dwims @a[?foo()] as scalar');
is(@z[0], 'S', 'lhs dwims @a[?foo()] as scalar');
is(@z[1], 'L', 'lhs dwims @a[?foo()] as scalar');
}
{
my @a;
my sub foo { 1 }
my @z = (@a[!foo()] = W, W);
is(@a, 'S', 'lhs dwims @a[!foo()] as scalar');
is(@z[0], 'S', 'lhs dwims @a[!foo()] as scalar');
is(@z[1], 'L', 'lhs dwims @a[!foo()] as scalar');
}
{
my @a;
my $b = 0;
my sub foo { 0 }
my @z = (@a[foo()] = W, W);
is(@a, 'L L', 'lhs dwims @a[foo()] as run-time scalar');
is(@z[0], 'L L', 'lhs dwims @a[foo()] as run-time scalar');
is(@z[1], undef, 'lhs dwims @a[foo()] as run-time scalar');
}
{
my @a;
my $b = 0;
my sub foo { 0,1 }
my @z = (@a[foo()] = W, W);
is(@a, 'L L', 'lhs dwims @a[foo()] as run-time list');
is(@z[0], 'L', 'lhs dwims @a[foo()] as run-time list');
is(@z[1], 'L', 'lhs dwims @a[foo()] as run-time list');
}
{
my %a;
my sub foo { 0 }
my @z = (%a{+foo()} = W, W);
is(%a, 'S', 'lhs dwims %a{+foo()} as scalar', :todo<bug>);
is(@z[0], 'S', 'lhs dwims %a{+foo()} as scalar');
is(@z[1], 'L', 'lhs dwims %a{+foo()} as scalar');
}
{
my %a;
my sub foo { '0' }
my @z = (%a{~foo()} = W, W);
is(%a, 'S', 'lhs dwims %a{~foo()} as scalar', :todo<bug>);
is(@z[0], 'S', 'lhs dwims %a{~foo()} as scalar');
is(@z[1], 'L', 'lhs dwims %a{~foo()} as scalar');
}
{
my %a;
my sub foo { 0 }
my @z = (%a{?foo()} = W, W);
is(%a, 'S', 'lhs dwims %a{?foo()} as scalar', :todo<bug>);
is(@z[0], 'S', 'lhs dwims %a{?foo()} as scalar');
is(@z[1], 'L', 'lhs dwims %a{?foo()} as scalar');
}
{
my %a;
my sub foo { 1 }
my @z = (%a{!foo()} = W, W);
is(%a, 'S', 'lhs dwims %a{!foo()} as scalar', :todo<bug>);
is(@z[0], 'S', 'lhs dwims %a{!foo()} as scalar');
is(@z[1], 'L', 'lhs dwims %a{!foo()} as scalar');
}
{
my %a;
my $b = 0;
my sub foo { 0 }
my @z = (%a{foo()} = W, W);
is(%a{0}, 'L L', 'lhs dwims %a{foo()} as run-time scalar');
is(@z[0], 'L L', 'lhs dwims %a{foo()} as run-time scalar');
is(@z[1], undef, 'lhs dwims %a{foo()} as run-time scalar');
}
{
my %a;
my $b = 0;
my sub foo { 0,1 }
my @z = (%a{foo()} = W, W);
is(%a{0}, 'L', 'lhs dwims %a{foo()} as run-time list');
is(%a{1}, 'L', 'lhs dwims %a{foo()} as run-time list');
is(@z[0], 'L', 'lhs dwims %a{foo()} as run-time list');
is(@z[1], 'L', 'lhs dwims %a{foo()} as run-time list');
}
{
my @a;
my @z = (@a[0+0] = W, W);
is(@a, 'S', 'lhs dwims @a[0+0] as scalar');
is(@z[0], 'S', 'lhs dwims @a[0+0] as scalar');
is(@z[1], 'L', 'lhs dwims @a[0+0] as scalar');
}
{
my @a;
my @z = (@a[0*0] = W, W);
is(@a, 'S', 'lhs dwims @a[0*0] as scalar');
is(@z[0], 'S', 'lhs dwims @a[0*0] as scalar');
is(@z[1], 'L', 'lhs dwims @a[0*0] as scalar');
}
{
my @a;
my @z = (@a[0/1] = W, W);
is(@a, 'S', 'lhs dwims @a[0/1] as scalar');
is(@z[0], 'S', 'lhs dwims @a[0/1] as scalar');
is(@z[1], 'L', 'lhs dwims @a[0/1] as scalar');
}
{
my @a;
my @z = (@a[0*1**1] = W, W);
is(@a, 'S', 'lhs dwims @a[0*1**1] as scalar');
is(@z[0], 'S', 'lhs dwims @a[0*1**1] as scalar');
is(@z[1], 'L', 'lhs dwims @a[0*1**1] as scalar');
}
{
my @a;
my $b = 0;
my @z = (@a[$b++] = W, W);
is(@a, 'S', 'lhs dwims @a[$b++] as scalar');
is(@z[0], 'S', 'lhs dwims @a[$b++] as scalar');
is(@z[1], 'L', 'lhs dwims @a[$b++] as scalar');
}
{
my @a;
my $b = 1;
my @z = (@a[--$b] = W, W);
is(@a, 'S', 'lhs dwims @a[--$b] as scalar');
is(@z[0], 'S', 'lhs dwims @a[--$b] as scalar');
is(@z[1], 'L', 'lhs dwims @a[--$b] as scalar');
}
{
my @a;
my @z = (@a[0==1] = W, W);
is(@a, 'L L', 'lhs dwims @a[0==1] as list (but coerce rhs list to one thing)');
is(@z[0], 'L L', 'lhs dwims @a[0==1] as list (but coerce rhs list to one thing)');
is(@z[1], undef, 'lhs dwims @a[0==1] as list (but coerce rhs list to one thing)');
}
{
my @a;
my @z = (@a[rand 1] = W, W);
is(@a, 'L L', 'lhs dwims @a[rand 1] as run-time scalar');
is(@z[0], 'L L', 'lhs dwims @a[rand 1] as run-time scalar');
is(@z[1], undef, 'lhs dwims @a[rand 1] as run-time scalar');
}
{
my @a;
my @z = (@a[rand 1,] = W, W);
is(@a, 'L', 'lhs dwims @a[rand 1,] as list');
is(@z[0], 'L', 'lhs dwims @a[rand 1,] as list');
is(@z[1], undef, 'lhs dwims @a[rand 1,] as list');
}
{
my @a;
my @z = (@a[(0|0).pick] = W, W);
is(@a, 'L L', 'lhs dwims @a[(0|0).pick] as list');
is(@z[0], 'L L', 'lhs dwims @a[(0|0).pick] as list');
is(@z[1], undef, 'lhs dwims @a[(0|0).pick] as list');
}