(perl #133778) adjust MARK if we extend the stack in pp_repeat
[perl.git] / t / op / multideref.t
1 #!./perl
2 #
3 # test OP_MULTIDEREF.
4 #
5 # This optimising op is used when one or more array or hash aggregate
6 # lookups / derefs are performed, and where each key/index is a simple
7 # constant or scalar var; e.g.
8 #
9 #       $r->{foo}[0]{$k}[$i]
10
11
12 BEGIN {
13     chdir 't';
14     require './test.pl';
15     set_up_inc("../lib");
16 }
17
18 use warnings;
19 use strict;
20
21 plan 63;
22
23
24 # check that strict refs hint is handled
25
26 {
27     package strict_refs;
28
29     our %foo;
30     my @a = ('foo');
31     eval {
32         $a[0]{k} = 7;
33     };
34     ::like($@, qr/Can't use string/, "strict refs");
35     ::ok(!exists $foo{k}, "strict refs, not exist");
36
37     no strict 'refs';
38
39     $a[0]{k} = 13;
40     ::is($foo{k}, 13, "no strict refs, exist");
41 }
42
43 # check the basics of multilevel lookups
44
45 {
46     package basic;
47
48     # build up the multi-level structure piecemeal to try and avoid
49     # relying on what we're testing
50
51     my @a;
52     my $r = \@a;
53     my $rh = {};
54     my $ra = [];
55     my %h = qw(a 1 b 2 c 3 d 4 e 5 f 6);
56     push @a, 66, 77, 'abc', $rh;
57     %$rh = (foo => $ra, bar => 'BAR');
58     push @$ra, 'def', \%h;
59
60     our ($i1, $i2,  $k1,  $k2)  = (3, 1, 'foo', 'c');
61     my ($li1, $li2, $lk1, $lk2) = (3, 1, 'foo', 'c');
62     my $z = 0;
63
64     # fetch
65
66     ::is($a[3]{foo}[1]{c}, 3,             'fetch: const indices');
67     ::is($a[$i1]{$k1}[$i2]{$k2}, 3,       'fetch: pkg indices');
68     ::is($r->[$i1]{$k1}[$i2]{$k2}, 3,     'fetch: deref pkg indices');
69     ::is($a[$li1]{$lk1}[$li2]{$lk2}, 3,   'fetch: lexical indices');
70     ::is($r->[$li1]{$lk1}[$li2]{$lk2}, 3, 'fetch: deref lexical indices');
71     ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 3,
72                             'fetch: general expression and index');
73
74
75     # store
76
77     ::is($a[3]{foo}[1]{c} = 5, 5,             'store: const indices');
78     ::is($a[3]{foo}[1]{c}, 5,                 'store: const indices 2');
79     ::is($a[$i1]{$k1}[$i2]{$k2} = 7, 7,       'store: pkg indices');
80     ::is($a[$i1]{$k1}[$i2]{$k2}, 7,           'store: pkg indices 2');
81     ::is($r->[$i1]{$k1}[$i2]{$k2} = 9, 9,     'store: deref pkg indices');
82     ::is($r->[$i1]{$k1}[$i2]{$k2}, 9,         'store: deref pkg indices 2');
83     ::is($a[$li1]{$lk1}[$li2]{$lk2} = 11, 11, 'store: lexical indices');
84     ::is($a[$li1]{$lk1}[$li2]{$lk2}, 11,      'store: lexical indices 2');
85     ::is($r->[$li1]{$lk1}[$li2]{$lk2} = 13, 13, 'store: deref lexical indices');
86     ::is($r->[$li1]{$lk1}[$li2]{$lk2}, 13,    'store: deref lexical indices 2');
87     ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2} = 15, 15,
88                             'store: general expression and index');
89     ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 15,
90                             'store: general expression and index 2');
91
92
93     # local
94
95     {
96         ::is(local $a[3]{foo}[1]{c} = 19, 19,     'local const indices');
97         ::is($a[3]{foo}[1]{c}, 19,                'local const indices 2');
98     }
99     ::is($a[3]{foo}[1]{c}, 15,          'local const indices 3');
100     {
101         ::is(local $a[$i1]{$k1}[$i2]{$k2} = 21, 21,     'local pkg indices');
102         ::is($a[$i1]{$k1}[$i2]{$k2}, 21,          'local pkg indices 2');
103     }
104     ::is($a[$i1]{$k1}[$i2]{$k2}, 15,     'local pkg indices 3');
105     {
106         ::is(local $a[$li1]{$lk1}[$li2]{$lk2} = 23, 23, 'local lexical indices');
107         ::is($a[$li1]{$lk1}[$li2]{$lk2}, 23,      'local lexical indices 2');
108     }
109     ::is($a[$li1]{$lk1}[$li2]{$lk2}, 15, 'local lexical indices 3');
110     {
111         ::is(local+($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2} = 25, 25,
112                                                             'local general');
113         ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 25,      'local general 2');
114     }
115     ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 15, 'local general 3');
116
117
118     # exists
119
120     ::ok(exists $a[3]{foo}[1]{c},           'exists: const indices');
121     ::ok(exists $a[$i1]{$k1}[$i2]{$k2},     'exists: pkg indices');
122     ::ok(exists $r->[$i1]{$k1}[$i2]{$k2},   'exists: deref pkg indices');
123     ::ok(exists $a[$li1]{$lk1}[$li2]{$lk2}, 'exists: lexical indices');
124     ::ok(exists $r->[$li1]{$lk1}[$li2]{$lk2}, 'exists: deref lexical indices');
125     ::ok(exists +($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 'exists: general');
126
127     # delete
128
129     our $k3 = 'a';
130     my $lk4 = 'b';
131     ::is(delete $a[3]{foo}[1]{c}, 15,          'delete: const indices');
132     ::is(delete $a[$i1]{$k1}[$i2]{$k3}, 1,     'delete: pkg indices');
133     ::is(delete $r->[$i1]{$k1}[$i2]{d}, 4,     'delete: deref pkg indices');
134     ::is(delete $a[$li1]{$lk1}[$li2]{$lk4}, 2, 'delete: lexical indices');
135     ::is(delete $r->[$li1]{$lk1}[$li2]{e}, 5,  'delete: deref lexical indices');
136     ::is(delete +($r//0)->[$li1]{$lk1}[$li2+$z]{f}, 6,  'delete: general');
137
138     # !exists
139
140     ::ok(!exists $a[3]{foo}[1]{c},            '!exists: const indices');
141     ::ok(!exists $a[$i1]{$k1}[$i2]{$k3},      '!exists: pkg indices');
142     ::ok(!exists $r->[$i1]{$k1}[$i2]{$k3},    '!exists: deref pkg indices');
143     ::ok(!exists $a[$li1]{$lk1}[$li2]{$lk4},  '!exists: lexical indices');
144     ::ok(!exists $r->[$li1]{$lk1}[$li2]{$lk4},'!exists: deref lexical indices');
145     ::ok(!exists +($r//0)->[$li1]{$lk1}[$li2+$z]{$lk4},'!exists: general');
146 }
147
148
149 # weird "constant" keys
150
151 {
152     use constant my_undef => undef;
153     use constant my_ref   => [];
154     no warnings 'uninitialized';
155     my %h1;
156     $h1{+my_undef} = 1;
157     is(join(':', keys %h1), '', "+my_undef");
158     my %h2;
159     $h2{+my_ref} = 1;
160     like(join(':', keys %h2), qr/x/, "+my_ref");
161 }
162
163
164
165 {
166     # test that multideref is marked OA_DANGEROUS, i.e. its one of the ops
167     # that should set the OPpASSIGN_COMMON flag in list assignments
168
169     my $x = {};
170     $x->{a} = [ 1 ];
171     $x->{b} = [ 2 ];
172     ($x->{a}, $x->{b}) = ($x->{b}, $x->{a});
173     is($x->{a}[0], 2, "OA_DANGEROUS a");
174     is($x->{b}[0], 1, "OA_DANGEROUS b");
175 }
176
177 # defer
178
179
180 sub defer {}
181
182 {
183     my %h;
184     $h{foo} = {};
185     defer($h{foo}{bar});
186     ok(!exists $h{foo}{bar}, "defer");
187 }
188
189 # RT #123609
190 # don't evaluate a const array index unless it's really a const array
191 # index
192
193 {
194     my $warn = '';
195     local $SIG{__WARN__} = sub { $warn .= $_[0] };
196     ok(
197         eval q{
198             my @a = (1);
199             my $arg = 0;
200             my $x = $a[ 'foo' eq $arg ? 1 : 0 ];
201             1;
202         },
203         "#123609: eval"
204     )
205         or diag("eval gave: $@");
206     is($warn, "", "#123609: warn");
207 }
208
209 # RT #130727
210 # a [ah]elem op can be both OPpLVAL_INTRO and OPpDEREF. It may not make
211 # much sense, but it shouldn't fail an assert.
212
213 {
214     my @x;
215     eval { @{local $x[0][0]} = 1; };
216     like $@, qr/Can't use an undefined value as an ARRAY reference/,
217                     "RT #130727 error";
218     ok !defined $x[0][0],"RT #130727 array not autovivified";
219
220     eval { @{1, local $x[0][0]} = 1; };
221     like $@, qr/Can't use an undefined value as an ARRAY reference/,
222                     "RT #130727 part 2: error";
223     ok !defined $x[0][0],"RT #130727 part 2: array not autovivified";
224
225 }
226
227 # RT #131627: assertion failure on OPf_PAREN on OP_GV
228 {
229     my @x = (10..12);
230     our $rt131627 = 1;
231
232     no strict qw(refs vars);
233     is $x[qw(rt131627)->$*], 11, 'RT #131627: $a[qw(var)->$*]';
234 }
235