Permalink
Fetching contributors…
Cannot retrieve contributors at this time
973 lines (831 sloc) 26.2 KB
use v6;
use Test;
# +---- UTF8 non-breaking space here!
# | (in case of 22-char wide screen)
# V
# L<S03/Changes to Perl 5 operators/list assignment operator now parses on the right>
plan 299;
# 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');
my Int $y;
lives-ok { &infix:<=>($y, 3) }, 'assignment as function with types (1)';
dies-ok { &infix:<=>($y, 'foo') }, 'assignment as function with types (2)';
}
{
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] = flat @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] = flat @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 assignments with skipped values
my ($one, $, $three) = 1..3;
is("$one $three", "1 3", 'list assignment my ($a, $, $b) = @ works');
my ($, $two) = 1..2;
is($two, 2, 'list assignment my ($, $a) = @ works');
my ($, $, $, $four) = 1..4;
is($four, 4, 'list assignment my ($, $, $, $a) = @ works');
my ($, @b, $c) = 1..4;
is(~@b, "2 3 4", 'list assignment my ($, @) = @ works');
ok(!defined($c), 'list assignment my ($, @, $c) = @ works');
}
{
# testing list assignments with skipped values
my ($one, $two, $three, $four);
($one, *, $three) = 1..3;
is("$one $three", "1 3", 'list assignment ($a, *, $b) = @ works');
(*, $two, *) = 1..3;
is($two, 2, 'list assignment (*, $a, *) = @ works');
(*, *, *, $four) = 1..4;
is($four, 4, 'list assignment (*, *, *, $a) = @ works');
my (@b, $c);
(*, @b, $c) = 1..4;
is(~@b, "2 3 4", 'list assignment (*, @) = @ works');
ok(!defined($c), 'list assignment (*, @, $c) = @ works');
}
# RT #118075
{
my ($one, $two, $three);
($one, $, $three) = 1..3;
is("$one $three", "1 3", 'list assignment ($a, $, $b) = @ works');
}
{
# testing signature binding with skipped values via *@ in a signature
my ($one, *@) = 1..4;
is($one, 1, 'signature binding my ($one, *@) = 1..4 works');
my ($a, $b, *@) = 1..4;
is("$a $b", "1 2", 'signature binding my ($a, $b, *@) = 1..4 works');
my ($c, $d, *@) = 1..2;
is("$c $d", "1 2", 'signature binding my ($c, $d, *@) = 1..2 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");
}
# RT #74302
{
my ($a, %b) = "!", a => "1", b => "2", c => "3";
is $a, "!", "got scalar in (scalar,hash) = list";
is %b.keys.sort.join(", "), "a, b, c", "got hash in (scalar,hash) = list";
}
{
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");
ok(!defined(@a[0]), "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");
is(@d[0], 400, "... and fourth");
is(@d[1], 500, "... and fifth");
ok(!defined(@c[0]), "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 my $scalar = my %hash = list assignment
my $s = my %h = 1,2;
my $t = %h;
is($s, $t, 'chained $ = % = list assignment');
}
{
# chained $scalar = %hash = list assignment
my ($s, $t, %h);
$s = %h = 1,2; # needs (1,2) to work, why???
$t = %h;
is($s, $t, 'chained $ = % = list assignment');
}
{
# (@b, @a) = (@a, @b) assignment
my (@a, @b);
@a = 1;
@b = 2;
(@b, @a) = flat (@a, @b);
ok(!defined(@a[0]), '(@b, @a) = (@a, @b) assignment \@a[0] == undefined');
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) = flat @a, @b;
ok(!defined(@a[0]), '(@b, @a) = @a, @b assignment \@a[0] == undefined');
is(@b[0], 1, '(@b, @a) = @a, @b assignment \@b[0]');
is(@b[1], 2, '(@b, @a) = @a, @b assignment \@b[1]');
}
my @p;
{
my $a;
@p = $a ||= 3, 4;
is($a,3, "||= operator");
is(@p[0],3, "||= operator parses as item assignment 1");
is(@p[1],4, "||= operator parses as item assignment 2");
@p = $a ||= 10, 11;
is($a,3, "... and second");
is(@p[0],3, "||= operator parses as item assignment 3");
is(@p[1],11, "||= operator parses as item assignment 4");
}
{
my $a;
@p = $a or= 3, 4;
is($a,(3,4), "or= operator");
is(@p[0][0],3, "or= operator parses as list assignment 1");
is(@p[0][1],4, "or= operator parses as list assignment 2");
@p = $a or= 10, 11;
is($a,(3,4), "... and second");
is(@p[0][0],3, "or= operator parses as list assignment 3");
is(@p[0][1],4, "or= operator parses as list assignment 4");
my $thunky = 0; 1 or= $thunky++;
is-deeply $thunky, 0, 'or= thunks RHS';
}
{
my $a;
@p = $a //= 3, 4;
is($a, 3, "//= operator");
is(@p[0],3, "//= operator parses as item assignment 1");
is(@p[1],4, "//= operator parses as item assignment 2");
@p = $a //= 10, 11;
is($a, 3, "... and second");
is(@p[0],3, "//= operator parses as item assignment 3");
is(@p[1],11, "//= operator parses as item assignment 4");
my %hash;
%hash<foo> //= hash();
isa-ok(%hash<foo>, Hash, "Verify //= autovivifies correctly");
%hash<bar> //= [];
isa-ok(%hash<bar>, Array, "Verify //= autovivifies correctly");
my $f //= 5;
is $f, 5, '//= also works in declaration';
}
{
my $a;
@p = $a orelse= 3, 4;
is($a, (3,4), "orelse= operator");
is(@p[0][0],3, "orelse= operator parses as list assignment 1");
is(@p[0][1],4, "orelse= operator parses as list assignment 2");
@p = $a orelse= 10, 11;
is($a, (3,4), "... and second");
is(@p[0][0],3, "orelse= operator parses as list assignment 3");
is(@p[0][1],4, "orelse= operator parses as list assignment 4");
my %hash;
%hash<foo> orelse= hash();
isa-ok(%hash<foo>, Hash, "Verify orelse= autovivifies correctly");
%hash<bar> orelse= [];
isa-ok(%hash<bar>, Array, "Verify orelse= autovivifies correctly");
my $f orelse= 5;
is $f, 5, 'orelse= also works in declaration';
}
{
my $a = 3;
@p = $a &&= 42, 43;
is($a, 42, "&&= operator");
is(@p[0],42, "&&= operator parses as item assignment 1");
is(@p[1],43, "&&= operator parses as item assignment 2");
$a = 0;
@p = $a &&= 10, 11;
is($a, 0, "... and second");
is(@p[0],0, "&&= operator parses as item assignment 3");
is(@p[1],11, "&&= operator parses as item assignment 4");
my $x = True; $x &&= False;
is($x, False, "&&= operator with True and False");
}
{
my $a = 3;
@p = $a and= 42, 43;
is($a, (42,43), "and= operator");
is(@p[0][0],42, "and= operator parses as list assignment 1");
is(@p[0][1],43, "and= operator parses as list assignment 2");
$a = 0;
@p = $a and= 10, 11;
is($a, 0, "... and second");
is(@p[0][0],0, "and= operator parses as list assignment 3");
ok(@p[0][1]:!exists, "and= operator parses as list assignment 4");
my $x = True; $x and= False;
is($x, False, "and= operator with True and False");
my $thunky = 0; 0 and= $thunky++;
is-deeply $thunky, 0, 'and= thunks RHS';
}
{
my $c;
(($c = 3) = 4);
is($c, 4, '(($c = 3) = 4) return val should be good as an lval');
}
{
my $x = 42;
@p = $x += 6, 7;
is($x, 48, '+= operator');
is(@p[0],48, "+= operator parses as item assignment 1");
is(@p[1],7, "+= operator parses as item assignment 2");
}
{
my $x = 42;
@p = $x -= 6, 7;
is($x, 36, '-= operator');
is(@p[0],36, "-= operator parses as item assignment 1");
is(@p[1],7, "-= operator parses as item assignment 2");
}
{
my $x = 4;
@p = $x *= 3, 2;
is($x, 12, '*= operator');
is(@p[0],12, "*= operator parses as item assignment 1");
is(@p[1],2, "*= operator parses as item assignment 2");
}
{
my $x = 6;
@p = $x div= 3, 4;
is($x, 2, 'div= operator');
is(@p[0],2, "div= operator parses as item assignment 1");
is(@p[1],4, "div= operator parses as item assignment 2");
}
{
my $x = 2;
@p = $x **= 3, 4;
is($x, 8, '**= operator');
is(@p[0],8, "**= operator parses as item assignment 1");
is(@p[1],4, "**= operator parses as item assignment 2");
}
{
my $x = "abc";
@p = $x ~= "yz", "plugh";
is($x, 'abcyz', '~= operator');
is(@p[0],'abcyz', "~= operator parses as item assignment 1");
is(@p[1],'plugh', "~= operator parses as item assignment 2");
}
# RT #64818
{
throws-like q{my $foo = 'foo'; $foo R~= 'foo';},
X::Assignment::RO,
'use of R~= operator on a non-container dies';
my ($x, $y) = <a b>; $x R~= $y;
is("$x $y", "a ba", "R~= operator works");
}
{
dies-ok { my $foo = Failure.new(); $foo += 1 },
"use of += on a Failure will trigger the failure to be thrown";
}
{
my $x = "abc";
@p = $x x= 3, 4;
is($x, 'abcabcabc', 'x= operator');
is(@p[0],'abcabcabc', "x= operator parses as item assignment 1");
is(@p[1],4, "x= operator parses as item assignment 2");
}
{
my $x = 1;
@p = $x +&= 2, 3;
is($x, 0, '+&= operator');
is(@p[0],0, "+&= operator parses as item assignment 1");
is(@p[1],3, "+&= operator parses as item assignment 2");
}
{
my $x = 1;
@p = $x +|= 2, 123;
is($x, 3, '+|= operator');
is(@p[0],3, "+|= operator parses as item assignment 1");
is(@p[1],123, "+|= operator parses as item assignment 2");
}
{
my $x = "z";
@p = $x ~&= "I", "J";
is($x, 'H', '~&= operator');
is(@p[0],'H', "~&= operator parses as item assignment 1");
is(@p[1],'J', "~&= operator parses as item assignment 2");
}
{
my $x = "z";
@p = $x ~|= "I", "J";
is($x, '{', '~|= operator');
is(@p[0],'{', "~|= operator parses as item assignment 1");
is(@p[1],'J', "~|= operator parses as item assignment 2");
}
{
my $x = 4;
@p = $x %= 3, 4;
is($x, 1, '%= operator');
is(@p[0],1, "%= operator parses as item assignment 1");
is(@p[1],4, "%= operator parses as item assignment 2");
}
{
my $x = 1;
@p = $x +^= 3, 4;
is($x, 2, '+^= operator');
is(@p[0],2, "+^= operator parses as item assignment 1");
is(@p[1],4, "+^= operator parses as item assignment 2");
}
{
my $x = "z";
@p = $x ~^= "C", "D";
is($x, 9, '~^= operator');
is(@p[0],9, "~^= operator parses as item assignment 1");
is(@p[1],'D', "~^= operator parses as item assignment 2");
}
{
my $x;
@p = $x ^^= 42, 43;
is($x, 42, '^^= operator');
is(@p[0],42, "^^= operator parses as item assignment 1");
is(@p[1],43, "^^= operator parses as item assignment 2");
$x ^^= 15;
is $x, Any, '^^= with two true arguments yields Nil -> Any';
$x ^^= 'xyzzy';
is $x, 'xyzzy', "^^= doesn't permanently falsify scalars";
}
# RT #76820
{
my $x;
@p = $x xor= 42, 43;
is($x, (42,43), 'xor= operator');
is(@p[0][0],42, "xor= operator parses as list assignment 1");
is(@p[0][1],43, "xor= operator parses as list assignment 2");
$x xor= 15;
is $x, Any, 'xor= with two true arguments yields Nil -> Any';
$x xor= 'xyzzy';
is $x, 'xyzzy', "xor= doesn't permanently falsify scalars";
}
{
my $x = 42;
@p = $x ?|= 24, 25;
is($x, True, '?|= operator');
is(@p[0], True, "?|= operator parses as item assignment 1");
is(@p[1],25, "?|= operator parses as item assignment 2");
}
{
my $x = 42;
@p = $x ?&= 24, 25;
is($x, True, '?&= operator');
is(@p[0], True, "?&= operator parses as item assignment 1");
is(@p[1], 25, "?&= operator parses as item assignment 2");
}
{
my $x = 0;
@p = $x ?^= 42, 43;
is($x, True, '?^= operator');
is(@p[0], True, "?^= operator parses as item assignment 1");
is(@p[1], 43, "?^= operator parses as item assignment 2");
}
{
my $x = 1;
@p = $x +<= 8, 9;
is($x, 256, '+<= operator');
is(@p[0],256, "+<= operator parses as item assignment 1");
is(@p[1],9, "+<= operator parses as item assignment 2");
}
{
my $x = 511;
@p = $x +>= 8, 9;
is($x, 1, '+>= operator');
is(@p[0],1, "+>= operator parses as item assignment 1");
is(@p[1],9, "+>= operator parses as item assignment 2");
}
# XXX: The following tests assume autoconvertion between "a" and buf8 type
#?rakudo 2 skip "~< and ~> NYI RT #124531"
{
my $x = "a";
@p = $x ~<= 8, 9;
is($x, "a\0", '~<= operator');
is(@p[0],"a\0", "~<= operator parses as item assignment 1");
is(@p[1],9, "~<= operator parses as item assignment 2");
}
{
my $x = "aa";
@p = $x ~>= 8, 9;
is($x, "a", '~>= operator');
is(@p[0],"a", "~>= operator parses as item assignment 1");
is(@p[1],9, "~>= operator parses as item assignment 2");
}
{
my $x = 42;
@p = $x [+]= 6, 7;
is($x, 48, '[+]= operator (just like +=)');
is(@p[0],48, "[+]= operator parses as item assignment 1");
is(@p[1],7, "[+]= operator parses as item assignment 2");
}
{
my $x = 42;
@p = $x [[+]]= 6, 7;
is($x, 48, '[[+]]= operator (just like +=)');
is(@p[0],48, "[[+]]= operator parses as item assignment 1");
is(@p[1],7, "[[+]]= operator parses as item assignment 2");
}
# Tests of dwimming scalar/listiness of lhs
sub l () { 1, 2 };
{
my $x;
$x = l(), 3, 4;
is $x.elems, 2, 'item assignment infix:<=> is tighter than the comma';
}
{
my $x;
my @a = ($x = l(), 3, 4);
is $x.elems, 2, 'item assignment infix:<=> is tighter than the comma (2)';
is @a.elems, 3, 'item assignment infix:<=> is tighter than the comma (3)';
}
{
package Foo {
our $b;
my @z = (flat $::('Foo::b') = l(), l());
is($b.elems, 2, q/lhs treats $::('Foo::b') as scalar (1)/);
is(@z.elems, 3, q/lhs treats $::('Foo::b') as scalar (2)/);
}
}
{
my @z = (flat $Foo::c = l, l);
is($Foo::c.elems, 2, 'lhs treats $Foo::c as scalar (1)');
is(@z.elems, 3, 'lhs treats $Foo::c as scalar (2)');
}
{
my @a;
my @z = ($(@a[0]) = l, l);
is(@a[0].elems, 2, 'lhs treats $(@a[0]) as scalar (1)');
is(@z.elems, 2, 'lhs treats $(@a[0]) as scalar (2)');
}
{
my $a;
my @z = (($a) = l, l, l);
is($a.elems, 3, 'lhs treats ($a) as list');
#?rakudo todo 'item/list assignment'
is(@z.elems, 3, 'lhs treats ($a) as list');
}
{
my $a;
my @z = (($a, *) = flat l, l, l);
is($a.elems, 1, 'lhs treats ($a, *) as list (1)');
#?rakudo todo 'list assignment with ($var, *)'
is(@z.elems, 6, 'lhs treats ($a, *) as list (2)');
}
#?rakudo skip 'cannot modify an immutable value RT #124533'
{
my $a;
my @z = (@$a = l, l, l);
is($a.elems, 6, 'lhs treats @$a as list (1)');
is @z.elems, 6, 'lhs treats @$a as list (2)';
}
#?rakudo skip 'cannot modify an immutable value RT #124533'
{
my $a;
$a[] = l, l, l;
is($a.elems, 6, 'lhs treats $a[] as list');
}
{
my $a;
my $b;
my @z = (($a,$b) = flat l, l);
is($a, 1, 'lhs treats ($a,$b) as list');
is($b, 2, 'lhs treats ($a,$b) as list');
is(+@z, 2, 'lhs treats ($a,$b) as list, and passes only two items on');
}
{
my @a;
my @z = (@a[0] = l, l);
#?rakudo todo 'list assignment to scalar'
is(@a[0].elems, 1, 'lhs treats @a[0] as one-item list');
is(@z.elems, 1, 'lhs treats @a[0] as one-item list');
ok(!defined(@a[1]), 'lhs treats @a[0] as one-item list');
}
{
my @a;
my @z = (@a[0,] = l, l);
is(@a[0,].elems, 1, 'lhs treats @a[0,] as one-item list');
is(@z.elems, 1, 'lhs treats @a[0,] as one-item list');
ok(defined(@a[1,]), 'lhs treats @a[0,] as one-item list');
}
{
my %a;
my @z = (%a<x> = l, l);
#?rakudo 2 todo 'list assignment to scalar'
is(%a{"x"}.elems, 1, 'lhs treats %a<x> as one-item list');
is(@z[0].elems, 1, 'lhs treats %a<x> as one-item list');
ok(!defined(@z[1]), 'lhs treats %a<x> as one-item list');
}
{
my %a;
my @z = (%a<x y z> = flat l, l);
is(%a<x>, 1, 'lhs treats %a<x y z> as list');
is(%a<y>, 2, 'lhs treats %a<x y z> as list');
is(%a<z>, 1, 'lhs treats %a<x y z> as list');
}
{
my %a;
my @z = (%a{'x'} = l, l);
#?rakudo 2 todo 'list assignment to scalar'
is(%a{"x"}, 1, q/lhs treats %a{'x'} as list/);
is(~@z[0], '1', q/lhs treats %a{'x'} as list/);
ok(!defined(@z[1]), q/lhs treats %a{'x'} as list/);
}
{
my %a;
my @z = (%a{'x','y','z'} = flat l, l);
is(%a<x>, 1, q/lhs treats %a{'x','y','z'} as list/);
is(%a<y>, 2, q/lhs treats %a{'x','y','z'} as list/);
is(%a<z>, 1, q/lhs treats %a{'x','y','z'} as list/);
is(@z[0], 1, q/lhs treats %a{'x','y','z'} as list/);
is(@z[1], 2, q/lhs treats %a{'x','y','z'} as list/);
is(@z[2], 1, q/lhs treats %a{'x','y','z'} as list/);
}
{
my %a;
my @z = (%a{'x'..'z'} = flat l, l);
is(%a<x>, 1, q/lhs treats %a{'x'..'z'} as list/);
is(%a<y>, 2, q/lhs treats %a{'x'..'z'} as list/);
is(%a<z>, 1, q/lhs treats %a{'x'..'z'} as list/);
is(@z[0], 1, q/lhs treats %a{'x'..'z'} as list/);
is(@z[1], 2, q/lhs treats %a{'x'..'z'} as list/);
is(@z[2], 1, q/lhs treats %a{'x'..'z'} as list/);
}
{
my @a;
my @b = (0,0);
my $c = 1;
my @z = (@a[@b[$c]] = l, l);
#?rakudo 3 todo 'list assignment, autovivification (?)'
is(~@a, '1', 'lhs treats @a[@b[$c]] as list');
is(~@z[0], '1', 'lhs treats @a[@b[$c]] as list');
is(!defined(@z[1]), 'lhs treats @a[@b[$c]] as list');
}
{
my @a;
my @b = (0,0);
my $c = 1;
my @z = (@a[@b[$c,]] = flat l, l);
is(~@a, '1', 'lhs treats @a[@b[$c,]] as list');
#?rakudo todo 'list assignment'
is(~@z[0], '2', 'lhs treats @a[@b[$c,]] as list');
ok(!defined(@z[1]), 'lhs treats @a[@b[$c,]] as list');
}
{
my @a;
my $b = 0;
my sub foo { @a }
my @z = (foo()[$b] = l, l);
is(@a.elems, 1, 'lhs treats foo()[$b] as list');
#?rakudo todo 'list assignment'
is(@z[0].elems, 1, 'lhs treats foo()[$b] as list');
ok(!defined(@z[1]), 'lhs treats foo()[$b] as list');
}
{
my @a;
my $b = 0;
my sub foo { @a }
my @z = (foo()[$b,] = flat l, l);
is(@a.elems, 1, 'lhs treats foo()[$b,] as list');
is(@z[0].elems, 1, 'lhs treats foo()[$b,] as list');
ok(!defined(@z[1]), 'lhs treats foo()[$b,] as list');
}
{
my @a;
my $b = 0;
my @z = ($(@a[$b]) = l, l);
is(@a.elems, 1, 'lhs treats $(@a[$b]) as item (1)');
#?rakudo 2 todo 'item assignment'
is(@a[0].elems, 1, 'lhs treats $(@a[$b]) as item (2)');
is(@z[1].elems, 3, 'lhs treats $(@a[$b]) as item (3)');
}
# L<S03/Assignment operators/",=">
#?rakudo skip ',= needs to be special cased after GLR to compile to push(@a, 3, 4)'
{
my @a = 1, 2;
is (@a ,= 3, 4).join('|'), '1|2|3|4', ',= on lists works the same as push (return value)';
is @a.join('|'), '1|2|3|4', ',= on lists works the same as push (effect on array)';
}
# RT #63642
{
my %part1 = a => 'b';
my %part2 = d => 'c';
my %both = %part1, %part2;
my %retval = ( %part1 ,= %part2 );
ok %retval eqv %both, ',= works for hashes (return value)';
ok %part1 eqv %both, ',= works for hashes (hash modified)';
}
{
my $s = 'abc';
$s .= subst('b','d');
is $s, 'adc', '.= on scalars works';
my @a = 'abc';
@a[0] .= subst('b','d');
is @a[0], 'adc', '.= on array indexed values';
my %h = x => 'abc';
%h<x> .= subst('b','d');
is %h<x>, 'adc', '.= on hash keyed values';
}
{
my $x = 3;
$x min= 2;
is $x, 2, 'min= worked (positive)';
$x = 3;
$x min= 5;
is $x, 3, 'min= worked (negative)';
$x = 1;
$x max= 2;
is $x, 2, 'max= worked (positive)';
$x = 3;
$x max= 2;
is $x, 3, 'max= worked (negative)';
}
# from ye auld t/syntax/decl_vs_assign_prec.t
{
is((try {my $t; $t = (1 == 1) ?? "true" !! "false"; $t}), "true", 'my $t; $t = (cond) ?? !! gets value from ?? !!, not conds bool');
is((try {my $t; $t = (1 == 0) ?? "true" !! "false"; $t}), "false", '.. also for false');
is((try {our $t; $t = (1 == 1) ?? "true" !! "false"; $t}), "true", 'truth with "our"');
is((try {our $t; $t = (1 == 0) ?? "true" !! "false"; $t}), "false", '... and false');
is((try {my $t = (1 == 1) ?? "true" !! "false"; $t}), "true", 'my $t = (cond) ?? !! gets value from ?? !!');
is((try {my $t = (1 == 0) ?? "true" !! "false"; $t}), "false", '.. also for false');
}
# RT #75950
{
my $x;
lives-ok { ($x,) = grep 5, 1..1_000_000 },
'Can grep lazily through a very long range';
is $x, 5, '... with correct result';
}
# RT #80614
{
my @a = 1,2,3;
my @b;
my $rt80614 = @b[0] = @a[1];
is $rt80614, 2, 'assignment to scalar via array item from array item';
is @b[0], 2, 'assignment to array item from array item to scalar';
my $x;
my @c; @c = (); # used to break chained assignment below
$x = @c[0] = 21;
is @c[0], 21, 'chained assignment works';
my @d;
my $y; ($y) = 1; # used to break chained assignment below
my $z = @d[0] = 42;
is @d[0], 42, 'chained assignment works';
}
# RT #125407
{
my @rt125407 = 84, 85;
if False { # note how this never runs
my @ref;
@ref[0] = 1; # used to break chained assignment below
}
my $rt125407 = @rt125407[0] = @rt125407.pop;
is $rt125407, @rt125407[0], '$rt125407 and @rt125407[0] should be equal';
}
# RT #77142
{
my $cc = 0;
sub called($ignored) { #OK not used
$cc = 1;
};
throws-like { EVAL 'called pi = 4' }, X::Assignment::RO,
'correct precedence between sub call and assignment (1)';
is $cc, 0,
'correct precedence between sub call and assignment (2)';
}
# RT #77586
{
my %bughunt = 1 => "foo", 2 => "bar", 3 => "foo";
my %correct = grep { .value ne "bar" }, %bughunt.pairs;
%bughunt = grep { .value ne "bar" }, %bughunt.pairs;
is %bughunt, %correct,
'Assign to hash with the same hash on rhs (RT #77586)';
}
# RT #93972
{
my $rt93972 = 1, 2, 3;
$rt93972 = $rt93972.grep({1});
is $rt93972, [1],
'Assign to array with the same array on rhs (RT #93972)';
$rt93972 = (1, 2, 3);
$rt93972 = $rt93972.grep({1});
is $rt93972.join(','), '1,2,3', 'same with List';
}
{
my @bughunt = 1, 2, 3;
@bughunt = @bughunt.grep(1);
is @bughunt, [1],
'Assign to array with the same array on rhs (RT #93972)';
}
# RT #77174
{
my @a //= (3);
is @a, "";
my @b ||= (3);
is @b, "3";
}
# RT #76444
{
(my $a) = 1,2,3;
is $a, (1,2,3), "Assignment into parentheses'd my works.";
sub foo($x) { $x };
is (foo (my $y = 1,2,3)), (1,2,3), "Routine call taking a parenthesised my as argument works. #1";
sub low-prec(\i) { True };
is (low-prec (my $x = (3,2,1))), True, "Routine call taking a parenthesised my as argument works. #2";
is $x, (3,2,1), "Routine call taking a parenthesised my as argument works. #3";
}
# RT #76414
#?rakudo skip ',= needs to be special cased after GLR to compile to push(@a, 3, 4)'
{
my @rt76414 = (1, 2);
@rt76414 ,= 3, 4; # same as push(@rt76414,3,4) according to S03
is @rt76414, (1, 2, 3, 4),
'infix:<,=> has list precedence in the cases where infix:<=> does';
}
# RT #72874
{
throws-like { EVAL "6 >== 2" }, X::Syntax::CannotMeta,
"Can't use diffy >= with the = metaop ";
}
{
throws-like { EVAL "6 ~~= 2" }, X::Syntax::CannotMeta,
"Can't use fiddly ~~ with the = metaop ";
}
# RT #116178
{
my $x //= .uc for 'a';
is $x, 'A',
'default-assignment (//=) does mix with implicit-variable method call';
}
# RT #125416
{
sub x(*@x) { +@x }
is x(1.Int, my $x = 2, 3), 3, 'declarator gets its own precedence analysis (1)';
is x(Int(1), my $y = 2, 3), 3, 'declarator gets its own precedence analysis (2)';
}
{
my (@foo,$bar);
@foo = $bar = 5, 10;
is $bar, 5, 'Chained assignment respects right associativity when evaluating left sigil for $';
is @foo, '5 10', 'Internal chained item assignment does not mess up outer list assignment';
}
# RT #124316
{
my @a;
@a[^2] = 42,43;
is @a, [42,43], '@a[^2] on empty array vivifies the slots and assignment works';
}
{
my $thunky1 = 0; Int andthen= $thunky1++;
is-deeply $thunky1, 0, 'andthen= thunks RHS';
my $thunky2 = 0; 42 notandthen= $thunky2++;
is-deeply $thunky2, 0, 'notandthen= thunks RHS';
my $thunky3 = 0; 42 orelse= $thunky3++;
is-deeply $thunky3, 0, 'orelse= thunks RHS';
}
# vim: ft=perl6