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