Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 962 lines (836 sloc) 26.33 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 283;
# 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);
#?pugs todo
is($x, 0, 'assignment operator called as function');
my Int $y;
lives_ok { &infix:<=>($y, 3) }, 'assignment as function with types (1)';
#?pugs todo
dies_ok { &infix:<=>($y, 'foo') }, 'assignment as function with types (2)';
}
#?pugs todo
{
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');
}
#?pugs skip 'skipping assignment with skipped values via $'
{
# 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');
}
#?pugs skip "skipping assignment with skipped values via * in signature"
{
# 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');
}
#?pugs skip "skipping assignment with skipped values via * in lvalue"
{
# 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');
}
#?pugs skip 'NYI'
{
# 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");
#?pugs todo
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";
#?pugs todo
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;
#?pugs todo
is(@b[0], 1, "assigned correct value from list to unsorted sliced array");
#?pugs todo
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");
#?pugs todo
is(@c[2], 200, "... and second");
#?pugs 3 todo 'feature'
#?niecza 3 todo 'feature'
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');
}
#?rakudo skip 'Odd number of elements found where hash expected'
{
# 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);
#?pugs todo
ok(!defined(@a[0]), '(@b, @a) = (@a, @b) assignment \@a[0] == undefined');
is(@b[0], 1, '(@b, @a) = (@a, @b) assignment \@b[0]');
#?pugs todo
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;
#?pugs todo
ok(!defined(@a[0]), '(@b, @a) = @a, @b assignment \@a[0] == undefined');
is(@b[0], 1, '(@b, @a) = @a, @b assignment \@b[0]');
#?pugs todo
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");
}
#?niecza todo
#?pugs todo
{
my $a;
@p = $a or= 3, 4;
is($a,3, "or= operator");
is(@p[0],3, "or= operator parses as item assignment 1");
is(@p[1],4, "or= operator parses as item assignment 2");
@p = $a or= 10, 11;
is($a,3, "... and second");
is(@p[0],3, "or= operator parses as item assignment 3");
is(@p[1],11, "or= operator parses as item assignment 4");
}
{
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';
}
#?pugs skip 'Cannot cast from VList [] to Handle'
{
my $a;
@p = $a orelse= 3, 4;
#?niecza 3 todo
is($a, 3, "orelse= operator");
is(@p[0],3, "orelse= operator parses as item assignment 1");
is(@p[1],4, "orelse= operator parses as item assignment 2");
@p = $a orelse= 10, 11;
#?niecza 3 todo
is($a, 3, "... and second");
is(@p[0],3, "orelse= operator parses as item assignment 3");
is(@p[1],11, "orelse= operator parses as item 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");
}
#?pugs skip 'Cannot cast from VInt 42 to Handle'
{
my $a = 3;
@p = $a and= 42, 43;
#?niecza 3 todo
is($a, 42, "and= operator");
is(@p[0],42, "and= operator parses as item assignment 1");
is(@p[1],43, "and= operator parses as item assignment 2");
$a = 0;
@p = $a and= 10, 11;
is($a, 0, "... and second");
is(@p[0],0, "and= operator parses as item assignment 3");
#?niecza todo
is(@p[1],11, "and= operator parses as item assignment 4");
my $x = True; $x and= False;
is($x, False, "and= operator with True and False");
}
{
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");
}
#?pugs skip 'div='
{
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
#?pugs skip 'R~= NYI'
{
eval_dies_ok q{my $foo = 'foo'; $foo R~= 'foo';},
'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");
}
{
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 = ( 'a', 'z' );
@p = @x xx= 3, 4;
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');
ok(!defined(@x[6]), 'xx= operator 6');
is(~@p,~(@x,4), "xx= operator parses as item assignment 1");
}
{
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");
}
#?niecza skip "Buffer bitops NYI"
{
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");
}
#?niecza skip "Buffer bitops NYI"
{
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");
}
#?niecza skip "Buffer bitops NYI"
{
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");
}
#?niecza skip "No ^^ yet"
{
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;
#?rakudo todo 'unknown'
is $x, False, '^^= with two true arguments yields False';
$x ^^= 'xyzzy';
is $x, 'xyzzy', "^^= doesn't permanently falsify scalars";
}
# RT #76820
#?niecza skip "No xor yet"
#?pugs skip 'Cannot cast from VInt 42 to Handle'
{
my $x;
@p = $x xor= 42, 43;
is($x, 42, 'xor= operator');
is(@p[0],42, "xor= operator parses as item assignment 1");
is(@p[1],43, "xor= operator parses as item assignment 2");
$x xor= 15;
#?rakudo todo 'unknown'
is $x, False, 'xor= with two true arguments yields False';
$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");
}
#?pugs eval 'parsefail'
{
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");
}
#?pugs eval 'parsefail'
{
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");
}
#?pugs eval 'parsefail'
{
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
#?pugs eval 'parsefail'
#?rakudo skip "unknown reasons"
#?niecza skip "Buffer bitops NYI"
{
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");
}
#?pugs eval 'parsefail'
#?rakudo skip "unknown reasons"
#?niecza skip "Buffer bitops NYI"
{
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");
}
# 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)';
}
#?rakudo skip 'item assignment, $::(...)'
{
package Foo {
our $b;
my @z = ($::('Foo::b') = l(), l());
#?pugs todo
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 = ($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)');
#?rakudo todo 'item assignment'
#?niecza todo
#?pugs todo
is(@z.elems, 2, 'lhs treats $(@a[0]) as scalar (2)');
}
#?niecza todo
{
my $a;
my @z = (($a) = l, l, l);
#?pugs todo
is($a.elems, 6, 'lhs treats ($a) as list');
#?rakudo todo 'item/list assignment'
#?pugs todo
is(@z.elems, 6, 'lhs treats ($a) as list');
}
#?pugs skip "Can't modify constant item: VNum Infinity"
{
my $a;
my @z = (($a, *) = l, l, l);
is($a.elems, 1, 'lhs treats ($a, *) as list (1)');
#?rakudo todo 'list assignment with ($var, *)'
#?niecza todo 'assigning to ($a, *)'
is(@z.elems, 6, 'lhs treats ($a, *) as list (2)');
}
#?rakudo skip '@$a'
#?niecza skip 'Unable to resolve method LISTSTORE in class List'
{
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 '$a[] autovivification (unspecced?)'
#?niecza skip '$a[] autovivification (unspecced?)'
#?pugs todo
{
my $a;
$a[] = l, l, l;
is($a.elems, 6, 'lhs treats $a[] as list');
}
{
my $a;
my $b;
my @z = (($a,$b) = 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'
#?niecza todo
#?pugs todo
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'
#?niecza 2 todo
#?pugs 2 todo
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> = 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'
#?niecza 2 todo
#?pugs 2 todo
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'} = 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'} = 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 (?)'
#?niecza 3 todo
#?pugs 3 todo
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,]] = l, l);
is(~@a, '1', 'lhs treats @a[@b[$c,]] as list');
#?rakudo todo 'list assignment'
#?niecza todo
#?pugs todo
is(~@z[0], '2', 'lhs treats @a[@b[$c,]] as list');
ok(!defined(@z[1]), 'lhs treats @a[@b[$c,]] as list');
}
#?rakudo skip 'unknown'
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = (foo()[$b] = l, l);
#?niecza todo
is(@a.elems, 1, 'lhs treats foo()[$b] as list');
#?rakudo todo 'list assignment'
#?pugs todo
is(@z[0].elems, 1, 'lhs treats foo()[$b] as list');
#?niecza todo
ok(!defined(@z[1]), 'lhs treats foo()[$b] as list');
}
#?rakudo skip 'unknown'
{
my @a;
my $b = 0;
my sub foo { \@a }
my @z = (foo()[$b,] = l, l);
#?niecza todo
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');
#?niecza todo
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'
#?niecza 2 todo
#?pugs 2 todo
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 ',='
#?pugs skip 'Cannot cast from VInt 3 to Handle'
{
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
#?pugs skip 'Cannot cast from VList to Handle'
{
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)';
}
#?pugs todo
{
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';
}
#?pugs skip 'min='
{
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
#?pugs skip 'Stack space overflow'
{
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';
#?rakudo todo 'RT 80614'
is @b[0], 2, 'assignment to array item from array item to scalar';
}
# RT #76734
#?rakudo skip 'RT #76734'
#?niecza skip "Overloading infix:<=> fails"
{
class A {};
my $x = ['a'];
multi infix:<=> (A $a, Str $value) { $x.push: $value; } #OK not used
(A.new() = 'b');
is $x.join(','), 'a,b', 'New multi infix:<=> works';
$x = 'c';
#?pugs todo
is $x, 'c', '...without screwing up ordinary assignment';
}
# RT #77142
{
my $cc = 0;
sub called($ignored) { #OK not used
$cc = 1;
};
#?pugs todo
dies_ok { called pi = 4 },
'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 Parcel';
}
#?pugs skip 'Cannot cast from VList to VCode'
{
my @bughunt = 1, 2, 3;
@bughunt = @bughunt.grep(1);
is @bughunt, [1],
'Assign to array with the same array on rhs (RT 93972)';
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.