Commit | Line | Data |
---|---|---|
98dfcb3f RZ |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | # use strict; | |
10 | ||
2186f873 | 11 | plan tests => 40; |
98dfcb3f RZ |
12 | |
13 | # simple use cases | |
14 | { | |
15 | my @a = 'a'..'z'; | |
16 | ||
17 | is( join(':', %a[0,1,2]), '0:a:1:b:2:c', "correct result and order"); | |
18 | is( join(':', %a[2,1,0]), '2:c:1:b:0:a', "correct result and order"); | |
19 | is( join(':', %a[1,0,2]), '1:b:0:a:2:c', "correct result and order"); | |
20 | ||
21 | ok( eq_hash( { %a[5,6] }, { 5 => 'f', 6 => 'g' } ), "correct hash" ); | |
22 | ||
23 | is( join(':', %a[()]), '', "correct result for empty slice"); | |
24 | } | |
25 | ||
26 | # not existing elements | |
27 | { | |
28 | my @a = 'a'..'d'; | |
29 | ok( eq_hash( { %a[3..4] }, { 3 => 'd', 4 => undef } ), | |
30 | "not existing returned with undef value" ); | |
31 | ||
32 | ok( !exists $a[5], "no autovivification" ); | |
33 | } | |
34 | ||
35 | # repeated keys | |
36 | { | |
37 | my @a = 'a'..'d'; | |
38 | @a = %a[ (1) x 3 ]; | |
39 | ok eq_array( \@a, [ (1 => 'b') x 3 ]), "repetead keys end with repeated results"; | |
40 | } | |
41 | ||
42 | # scalar context | |
43 | { | |
2186f873 FC |
44 | my @warn; |
45 | local $SIG{__WARN__} = sub {push @warn, "@_"}; | |
46 | ||
98dfcb3f | 47 | my @a = 'a'..'z'; |
2186f873 | 48 | is eval'scalar %a[4,5,6]', 'g', 'last element in scalar context'; |
98dfcb3f | 49 | |
2186f873 FC |
50 | like ($warn[0], |
51 | qr/^\%a\[\.\.\.\] in scalar context better written as \$a\[\.\.\.\]/); | |
98dfcb3f | 52 | |
2186f873 FC |
53 | eval 'is( scalar %a[5], "f", "correct value");'; |
54 | ||
55 | is (scalar @warn, 2); | |
56 | like ($warn[1], qr/^\%a\[5\] in scalar context better written as \$a\[5\]/); | |
98dfcb3f RZ |
57 | } |
58 | ||
59 | # autovivification | |
60 | { | |
61 | my @a = 'a'..'b'; | |
62 | ||
63 | my @t = %a[1,2]; | |
64 | is( join(':', map {$_//'undef'} @t), '1:b:2:undef', "correct result"); | |
65 | ok( eq_array( \@a, ['a', 'b'] ), "correct array" ); | |
66 | } | |
67 | ||
68 | # refs | |
69 | { | |
70 | my $a = [ 'a'..'z' ]; | |
71 | ||
72 | is( join(':', %$a[2,3,4]), '2:c:3:d:4:e', "correct result and order"); | |
73 | is( join(':', %{$a}[2,3,4]), '2:c:3:d:4:e', "correct result and order"); | |
74 | } | |
75 | ||
76 | # no interpolation | |
77 | { | |
78 | my @a = 'a'..'b'; | |
79 | is( "%a[1,2]", q{%a[1,2]}, 'no interpolation within strings' ); | |
80 | } | |
81 | ||
82 | # ref of a slice produces list | |
83 | { | |
84 | my @a = 'a'..'z'; | |
85 | my @tmp = \%a[2,3,4]; | |
86 | ||
87 | my $ok = 1; | |
88 | $ok = 0 if grep !ref, @tmp; | |
89 | ok $ok, "all elements are refs"; | |
90 | ||
91 | is join( ':', map{ $$_ } @tmp ), '2:c:3:d:4:e'; | |
92 | } | |
93 | ||
94 | # lvalue usage in foreach | |
95 | { | |
96 | my @a = qw(0 1 2 3); | |
97 | my @i = (1,3); | |
98 | $_++ foreach %a[@i]; | |
99 | ok( eq_array( \@a, [0,2,2,4] ), "correct array" ); | |
100 | ok( eq_array( \@i, [1,3] ), "indexes not touched" ); | |
101 | } | |
102 | ||
103 | # lvalue subs in foreach | |
104 | { | |
105 | my @a = qw(0 1 2 3); | |
106 | my @i = (1,3); | |
107 | sub foo:lvalue{ %a[@i] }; | |
108 | $_++ foreach foo(); | |
109 | ok( eq_array( \@a, [0,2,2,4] ), "correct array" ); | |
110 | ok( eq_array( \@i, [1,3] ), "indexes not touched" ); | |
111 | } | |
112 | ||
113 | # errors | |
114 | { | |
115 | my @a = 'a'..'b'; | |
116 | # no local | |
117 | { | |
118 | local $@; | |
119 | eval 'local %a[1,2]'; | |
120 | like $@, qr{^Can't modify index/value array slice in local at}, | |
121 | 'local dies'; | |
122 | } | |
123 | # no delete | |
124 | { | |
125 | local $@; | |
126 | eval 'delete %a[1,2]'; | |
127 | like $@, qr{^delete argument is index/value array slice, use array slice}, | |
128 | 'delete dies'; | |
129 | } | |
130 | # no assign | |
131 | { | |
132 | local $@; | |
133 | eval '%a[1,2] = qw(B A)'; | |
134 | like $@, qr{^Can't modify index/value array slice in list assignment}, | |
135 | 'assign dies'; | |
136 | } | |
137 | # lvalue subs in assignment | |
138 | { | |
139 | local $@; | |
140 | eval 'sub bar:lvalue{ %a[1,2] }; bar() = "1"'; | |
141 | like $@, qr{^Can't modify index/value array slice in list assignment}, | |
142 | 'not allowed as result of lvalue sub'; | |
143 | } | |
144 | } | |
145 | ||
146 | # warnings | |
147 | { | |
148 | my @warn; | |
149 | local $SIG{__WARN__} = sub {push @warn, "@_"}; | |
150 | ||
151 | my @a = 'a'..'c'; | |
152 | { | |
153 | @warn = (); | |
95a31aad | 154 | my $v = eval '%a[0]'; |
98dfcb3f | 155 | is (scalar @warn, 1, 'warning in scalar context'); |
2186f873 FC |
156 | like $warn[0], |
157 | qr{^%a\[0\] in scalar context better written as \$a\[0\]}, | |
98dfcb3f RZ |
158 | "correct warning text"; |
159 | } | |
160 | { | |
161 | @warn = (); | |
162 | my ($k,$v) = eval '%a[0]'; | |
163 | is ($k, 0); | |
164 | is ($v, 'a'); | |
95a31aad | 165 | is (scalar @warn, 0, 'no warning in list context'); |
98dfcb3f RZ |
166 | } |
167 | } | |
168 | ||
169 | # simple case with tied | |
170 | { | |
171 | require Tie::Array; | |
172 | tie my @a, 'Tie::StdArray'; | |
173 | @a = 'a'..'c'; | |
174 | ||
175 | ok( eq_array( [%a[1,2, 3]], [qw(1 b 2 c 3), undef] ), | |
176 | "works on tied" ); | |
177 | ||
178 | ok( !exists $a[3], "no autovivification" ); | |
179 | } | |
180 | ||
f263a88e FC |
181 | # keys/value/each treat argument as scalar |
182 | { | |
183 | my %h = 'a'..'b'; | |
184 | my @i = \%h; | |
d401967c | 185 | no warnings 'syntax', 'experimental::autoderef'; |
2186f873 | 186 | my ($k,$v) = each %i[0]; |
f263a88e FC |
187 | is $k, 'a', 'key returned by each %array[ix]'; |
188 | is $v, 'b', 'val returned by each %array[ix]'; | |
189 | %h = 1..10; | |
190 | is join('-', sort keys %i[(0)]), '1-3-5-7-9', 'keys %array[ix]'; | |
191 | is join('-', sort values %i[(0)]), '10-2-4-6-8', 'values %array[ix]'; | |
192 | } | |
193 | ||
194 | # \% prototype expects hash deref | |
195 | sub nowt_but_hash(\%) {} | |
196 | eval 'nowt_but_hash %_[0]'; | |
197 | like $@, qr`^Type of arg 1 to main::nowt_but_hash must be hash \(not(?x: | |
198 | ) index/value array slice\) at `, | |
199 | '\% prototype'; |