This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix assertion failure with ... ? \$a : \$b = ...
[perl5.git] / t / op / lvref.t
CommitLineData
72ed4618
FC
1BEGIN {
2 chdir 't';
3 require './test.pl';
4 set_up_inc("../lib");
5}
6
b7ae253e 7plan 42;
72ed4618 8
53abf431
FC
9sub on { $::TODO = ' ' }
10sub off{ $::TODO = '' }
72ed4618
FC
11
12eval '\$x = \$y';
13like $@, qr/^Experimental lvalue references not enabled/,
14 'error when feature is disabled';
26a50d99
FC
15eval '\($x) = \$y';
16like $@, qr/^Experimental lvalue references not enabled/,
17 'error when feature is disabled (aassign)';
72ed4618
FC
18
19use feature 'lvalue_refs';
20
21{
22 my($w,$c);
23 local $SIG{__WARN__} = sub { $c++; $w = shift };
24 eval '\$x = \$y';
25 is $c, 1, 'one warning from lv ref assignment';
26 like $w, qr/^Lvalue references are experimental/,
27 'experimental warning';
26a50d99
FC
28 undef $c;
29 eval '\($x) = \$y';
30 is $c, 1, 'one warning from lv ref list assignment';
31 like $w, qr/^Lvalue references are experimental/,
32 'experimental warning';
72ed4618
FC
33}
34
35no warnings 'experimental::lvalue_refs';
36
37# Scalars
38
39eval '\$x = \$y';
40is \$x, \$y, '\$pkg_scalar = ...';
41my $m;
53abf431 42\$m = \$y;
72ed4618 43is \$m, \$y, '\$lexical = ...';
fc048fcf 44\my $n = \$y;
72ed4618
FC
45is \$n, \$y, '\my $lexical = ...';
46@_ = \$_;
26a50d99 47\($x) = @_;
72ed4618 48is \$x, \$_, '\($pkgvar) = ... gives list context';
238ef7dc 49undef *x;
26a50d99 50(\$x) = @_;
238ef7dc 51is \$x, \$_, '(\$pkgvar) = ... gives list context';
26a50d99 52on;
72ed4618
FC
53my $o;
54eval '\($o) = @_';
55is \$o, \$_, '\($lexical) = ... gives list cx';
26a50d99 56my $q;
238ef7dc
FC
57eval '(\$q) = @_';
58is \$q, \$_, '(\$lexical) = ... gives list cx';
72ed4618
FC
59eval '\(my $p) = @_';
60is \$p, \$_, '\(my $lexical) = ... gives list cx';
238ef7dc
FC
61eval '(\my $r) = @_';
62is \$r, \$_, '(\my $lexical) = ... gives list cx';
63eval '\my($s) = @_';
64is \$s, \$_, '\my($lexical) = ... gives list cx';
72ed4618
FC
65eval '\($_a, my $a) = @{[\$b, \$c]}';
66is \$_a, \$b, 'package scalar in \(...)';
67is \$a, \$c, 'lex scalar in \(...)';
68eval '(\$_b, \my $b) = @{[\$b, \$c]}';
69is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
70is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
11ea28ee
FC
71is eval '\local $l = \3; $l', 3, '\local $scalar assignment';
72off;
73is $l, undef, 'localisation unwound';
29a3d628
FC
74\$foo = \*bar;
75is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
11ea28ee 76on;
72ed4618
FC
77
78# Array Elements
79
80# ...
81
82# Hash Elements
83
84# ...
85
86# Arrays
87
88# ...
89
90# Hashes
91
92# ...
93
94# Subroutines
95
96# ...
97
b7ae253e 98# Mixed List Assignments
72ed4618 99
26a50d99
FC
100off;
101(\$tahi, $rua) = \(1,2);
9fc71ff4
FC
102is join(' ', $tahi, $$rua), '1 2',
103 'mixed scalar ref and scalar list assignment';
26a50d99 104on;
b7ae253e
FC
105
106# Conditional expressions
107
9fc71ff4
FC
108$_ = 3;
109eval '$_ == 3 ? \$tahi : $rua = \3';
110is $tahi, 3, 'cond assignment resolving to scalar ref';
111eval '$_ == 3 ? \$toru : $wha = \3';
112is $$wha, 3, 'cond assignment resolving to scalar';
b7ae253e
FC
113eval '$_ == 3 ? \$rima : \$ono = \5';
114is $$rima, 5, 'cond assignment with refgens on both branches';
72ed4618 115
096cc2cc
FC
116# Foreach
117
118eval '
119 for \my $a(\$for1, \$for2) {
120 push @for, \$a;
121 }
122';
123is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
124
125@for = ();
126eval '
127 for \my @a([1,2], [3,4]) {
128 push @for, @a;
129 }
130';
131is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
132
133@for = ();
134eval '
135 for \my %a({5,6}, {7,8}) {
136 push @for, %a;
137 }
138';
139is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
140
141@for = ();
142eval '
143 for \my &a(sub {9}, sub {10}) {
144 push @for, &a;
145 }
146';
147is "@for", "9 10", 'foreach \my &a';
148
149
72ed4618
FC
150# Errors
151
b3717a0e
FC
152off;
153eval { my $x; \$x = 3 };
154like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
155eval { my $x; \$x = [] };
156like $@, qr/^Assigned value is not a SCALAR reference at/,
157 'assigning non-scalar ref to scalar ref';
d8a875d9
FC
158eval { \$::x = [] };
159like $@, qr/^Assigned value is not a SCALAR reference at/,
160 'assigning non-scalar ref to package scalar ref';
d6378458
FC
161
162on;
163eval '(\do{}) = 42';
164like $@, qr/^Can't modify reference to do block in list assignment at /,
165 "Can't modify reference to do block in list assignment";
166off;
167eval '(\pos) = 42';
168like $@,
169 qr/^Can't modify reference to match position in list assignment at /,
170 "Can't modify ref to some scalar-returning op in list assignment";
b3717a0e 171on;
d6378458
FC
172eval '(\glob) = 42';
173like $@,
174 qr/^Can't modify reference to glob in list assignment at /,
175 "Can't modify reference to some list-returning op in list assignment";
d6b7592f
FC
176off;
177eval '\pos = 42';
178like $@,
179 qr/^Can't modify reference to match position in scalar assignment at /,
180 "Can't modify ref to some scalar-returning op in scalar assignment";
181on;
781ff25d
FC
182
183# Miscellaneous
184
185{
186 my($x,$y);
187 sub {
188 sub {
189 \$x = \$y;
190 }->();
191 is \$x, \$y, 'lexical alias affects outer closure';
192 }->();
193 is \$x, \$y, 'lexical alias affects outer sub where vars are declared';
194}
81cb1af6
FC
195
196{ # PADSTALE has a double meaning
197 use feature 'lexical_subs', 'signatures', 'state';
198 no warnings 'experimental';
199 my $c;
200 my sub s ($arg) {
201 state $x = ++$c;
202 if ($arg == 3) { return $c }
203 goto skip if $arg == 2;
204 my $y;
205 skip:
206 # $y is PADSTALE the 2nd time
207 \$x = \$y if $arg == 2;
208 }
209 s(1);
210 s(2);
211 is s(3), 1, 'padstale alias should not reset state'
212}
cf5d2d91
FC
213
214off;
215SKIP: {
216 skip_without_dynamic_extension('List/Util');
217 require Scalar::Util;
218 my $a;
219 Scalar::Util::weaken($r = \$a);
220 \$a = $r;
221 pass 'no crash when assigning \$lex = $weakref_to_lex'
222}