1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = qw(. ../lib); 6} 7 8require "test.pl"; 9plan( tests => 64 ); 10 11@foo = (1, 2, 3, 4); 12cmp_ok($foo[0], '==', 1, 'first elem'); 13cmp_ok($foo[3], '==', 4, 'last elem'); 14 15$_ = join(':',@foo); 16cmp_ok($_, 'eq', '1:2:3:4', 'join list'); 17 18($a,$b,$c,$d) = (1,2,3,4); 19cmp_ok("$a;$b;$c;$d", 'eq', '1;2;3;4', 'list assign'); 20 21($c,$b,$a) = split(/ /,"111 222 333"); 22cmp_ok("$a;$b;$c",'eq','333;222;111','list split on space'); 23 24($a,$b,$c) = ($c,$b,$a); 25cmp_ok("$a;$b;$c",'eq','111;222;333','trio rotate'); 26 27($a, $b) = ($b, $a); 28cmp_ok("$a-$b",'eq','222-111','duo swap'); 29 30($a, $b) = ($b, $a) = ($a, $b); 31cmp_ok("$a-$b",'eq','222-111','duo swap swap'); 32 33($a, $b[1], $c{2}, $d) = (1, 2, 3, 4); 34cmp_ok($a,'==',1,'assign scalar in list'); 35cmp_ok($b[1],'==',2,'assign aelem in list'); 36cmp_ok($c{2},'==',3,'assign helem in list'); 37cmp_ok($d,'==',4,'assign last scalar in list'); 38 39@foo = (1,2,3,4,5,6,7,8); 40($a, $b, $c, $d) = @foo; 41cmp_ok("$a/$b/$c/$d",'eq','1/2/3/4','long list assign'); 42 43@foo = (1,2); 44($a, $b, $c, $d) = @foo; 45cmp_ok($a,'==',1,'short list 1 defined'); 46cmp_ok($b,'==',2,'short list 2 defined'); 47ok(!defined($c),'short list 3 undef'); 48ok(!defined($d),'short list 4 undef'); 49 50@foo = @bar = (1); 51cmp_ok(join(':',@foo,@bar),'eq','1:1','list reassign'); 52 53@foo = @bar = (2,3); 54cmp_ok(join(':',join('+',@foo),join('-',@bar)),'eq','2+3:2-3','long list reassign'); 55 56@foo = (); 57@foo = 1+2+3; 58cmp_ok(join(':',@foo),'eq','6','scalar assign to array'); 59 60{ 61 my ($a, $b, $c); 62 for ($x = 0; $x < 3; $x = $x + 1) { 63 ($a, $b, $c) = 64 $x == 0 ? ('a','b','c') 65 : $x == 1 ? ('d','e','f') 66 : ('g','h','i') 67 ; 68 if ($x == 0) { 69 cmp_ok($a,'eq','a','ternary for a 1'); 70 cmp_ok($b,'eq','b','ternary for b 1'); 71 cmp_ok($c,'eq','c','ternary for c 1'); 72 } 73 if ($x == 1) { 74 cmp_ok($a,'eq','d','ternary for a 2'); 75 cmp_ok($b,'eq','e','ternary for b 2'); 76 cmp_ok($c,'eq','f','ternary for c 2'); 77 } 78 if ($x == 2) { 79 cmp_ok($a,'eq','g','ternary for a 3'); 80 cmp_ok($b,'eq','h','ternary for b 3'); 81 cmp_ok($c,'eq','i','ternary for c 3'); 82 } 83 } 84} 85 86{ 87 my ($a, $b, $c); 88 for ($x = 0; $x < 3; $x = $x + 1) { 89 ($a, $b, $c) = do { 90 if ($x == 0) { 91 ('a','b','c'); 92 } 93 elsif ($x == 1) { 94 ('d','e','f'); 95 } 96 else { 97 ('g','h','i'); 98 } 99 }; 100 if ($x == 0) { 101 cmp_ok($a,'eq','a','block for a 1'); 102 cmp_ok($b,'eq','b','block for b 1'); 103 cmp_ok($c,'eq','c','block for c 1'); 104 } 105 if ($x == 1) { 106 cmp_ok($a,'eq','d','block for a 2'); 107 cmp_ok($b,'eq','e','block for b 2'); 108 cmp_ok($c,'eq','f','block for c 2'); 109 } 110 if ($x == 2) { 111 cmp_ok($a,'eq','g','block for a 3'); 112 cmp_ok($b,'eq','h','block for b 3'); 113 cmp_ok($c,'eq','i','block for c 3'); 114 } 115 } 116} 117 118$x = 666; 119@a = ($x == 12345 || (1,2,3)); 120cmp_ok(join('*',@a),'eq','1*2*3','logical or f'); 121 122@a = ($x == $x || (4,5,6)); 123cmp_ok(join('*',@a),'eq','1','logical or t'); 124 125cmp_ok(join('',1,2,(3,4,5)),'eq','12345','list ..(...)'); 126cmp_ok(join('',(1,2,3,4,5)),'eq','12345','list (.....)'); 127cmp_ok(join('',(1,2,3,4),5),'eq','12345','list (....).'); 128cmp_ok(join('',1,(2,3,4),5),'eq','12345','list .(...).'); 129cmp_ok(join('',1,2,(3,4),5),'eq','12345','list ..(..).'); 130cmp_ok(join('',1,2,3,(4),5),'eq','12345','list ...(.).'); 131cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list (..).(..)'); 132 133{ 134 my @a = (0, undef, undef, 3); 135 my @b = @a[1,2]; 136 my @c = (0, undef, undef, 3)[1, 2]; 137 cmp_ok(scalar(@b),'==',scalar(@c),'slice and slice'); 138 cmp_ok(scalar(@c),'==',2,'slice len'); 139 140 @b = (29, scalar @c[()]); 141 cmp_ok(join(':',@b),'eq','29:','slice ary nil'); 142 143 my %h = (a => 1); 144 @b = (30, scalar @h{()}); 145 cmp_ok(join(':',@b),'eq','30:','slice hash nil'); 146 147 my $size = scalar(()[1..1]); 148 cmp_ok($size,'==','0','size nil'); 149} 150 151{ 152 # perl #39882 153 sub test_zero_args { 154 my $test_name = shift; 155 is(scalar(@_), 0, $test_name); 156 } 157 test_zero_args("simple list slice", (10,11)[2,3]); 158 test_zero_args("grepped list slice", grep(1, (10,11)[2,3])); 159 test_zero_args("sorted list slice", sort((10,11)[2,3])); 160 test_zero_args("assigned list slice", my @tmp = (10,11)[2,3]); 161 test_zero_args("do-returned list slice", do { (10,11)[2,3]; }); 162 test_zero_args("list literal slice", qw(a b)[2,3]); 163 test_zero_args("empty literal slice", qw()[2,3]); 164} 165 166{ 167 # perl #20321 168 is (join('', @{[('abc'=~/./g)[0,1,2,1,0]]}), "abcba"); 169} 170 171{ 172 is(join('', qw(a b c)[2,0,1]), "cab"); 173 my @a = qw(a b c); 174 is(join(":", @a), "a:b:c"); 175 my @b = qw(); 176 is($#b, -1); 177} 178 179{ 180 # comma operator with lvalue only propagates the lvalue context to 181 # the last operand. 182 ("const", my $x) ||= 1; 183 is( $x, 1 ); 184} 185