This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add notes about effect of loop control statements inside
[perl5.git] / t / pragma / sub_lval.t
CommitLineData
cd06dffe
GS
1print "1..46\n";
2
3BEGIN {
4 chdir 't' if -d 't';
5 unshift @INC, '../lib';
6}
7
8sub a {use attrs 'lvalue'; my $a = 34; bless \$a} # Return a temporary
9sub b {use attrs 'lvalue'; shift}
10
11my $out = a(b()); # Check that temporaries are allowed.
12print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
13print "ok 1\n";
14
15my @out = grep /main/, a(b()); # Check that temporaries are allowed.
16print "# `@out'\nnot " unless @out==1; # Not reached if error.
17print "ok 2\n";
18
19my $in;
20
21# Check that we can return localized values from subroutines:
22
23sub in {use attrs 'lvalue'; $in = shift;}
24sub neg {use attrs 'lvalue'; #(num_str) return num_str
25 local $_ = shift;
26 s/^\+/-/;
27 $_;
28}
29in(neg("+2"));
30
31
32print "# `$in'\nnot " unless $in eq '-2';
33print "ok 3\n";
34
35sub get_lex {use attrs 'lvalue'; $in}
36sub get_st {use attrs 'lvalue'; $blah}
37sub id {use attrs 'lvalue'; shift}
38sub id1 {use attrs 'lvalue'; $_[0]}
39sub inc {use attrs 'lvalue'; ++$_[0]}
40
41$in = 5;
42$blah = 3;
43
44get_st = 7;
45
46print "# `$blah' ne 7\nnot " unless $blah eq 7;
47print "ok 4\n";
48
49get_lex = 7;
50
51print "# `$in' ne 7\nnot " unless $in eq 7;
52print "ok 5\n";
53
54++get_st;
55
56print "# `$blah' ne 8\nnot " unless $blah eq 8;
57print "ok 6\n";
58
59++get_lex;
60
61print "# `$in' ne 8\nnot " unless $in eq 8;
62print "ok 7\n";
63
64id(get_st) = 10;
65
66print "# `$blah' ne 10\nnot " unless $blah eq 10;
67print "ok 8\n";
68
69id(get_lex) = 10;
70
71print "# `$in' ne 10\nnot " unless $in eq 10;
72print "ok 9\n";
73
74++id(get_st);
75
76print "# `$blah' ne 11\nnot " unless $blah eq 11;
77print "ok 10\n";
78
79++id(get_lex);
80
81print "# `$in' ne 11\nnot " unless $in eq 11;
82print "ok 11\n";
83
84id1(get_st) = 20;
85
86print "# `$blah' ne 20\nnot " unless $blah eq 20;
87print "ok 12\n";
88
89id1(get_lex) = 20;
90
91print "# `$in' ne 20\nnot " unless $in eq 20;
92print "ok 13\n";
93
94++id1(get_st);
95
96print "# `$blah' ne 21\nnot " unless $blah eq 21;
97print "ok 14\n";
98
99++id1(get_lex);
100
101print "# `$in' ne 21\nnot " unless $in eq 21;
102print "ok 15\n";
103
104inc(get_st);
105
106print "# `$blah' ne 22\nnot " unless $blah eq 22;
107print "ok 16\n";
108
109inc(get_lex);
110
111print "# `$in' ne 22\nnot " unless $in eq 22;
112print "ok 17\n";
113
114inc(id(get_st));
115
116print "# `$blah' ne 23\nnot " unless $blah eq 23;
117print "ok 18\n";
118
119inc(id(get_lex));
120
121print "# `$in' ne 23\nnot " unless $in eq 23;
122print "ok 19\n";
123
124++inc(id1(id(get_st)));
125
126print "# `$blah' ne 25\nnot " unless $blah eq 25;
127print "ok 20\n";
128
129++inc(id1(id(get_lex)));
130
131print "# `$in' ne 25\nnot " unless $in eq 25;
132print "ok 21\n";
133
134@a = (1) x 3;
135@b = (undef) x 2;
136$#c = 3; # These slots are not fillable.
137
138# Explanation: empty slots contain &sv_undef.
139
140=for disabled constructs
141
142sub a3 {use attrs 'lvalue'; @a}
143sub b2 {use attrs 'lvalue'; @b}
144sub c4 {use attrs 'lvalue'; @c}
145
146$_ = '';
147
148eval <<'EOE' or $_ = $@;
149 ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
150 1;
151EOE
152
153#@out = ($x, a3, $y, b2, $z, c4, $t);
154#@in = (34 .. 41, (undef) x 4, 46);
155#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
156
157print "# '$_'.\nnot "
158 unless /Can\'t return an uninitialized value from lvalue subroutine/;
159=cut
160
161print "ok 22\n";
162
163my $var;
164
165sub a::var {use attrs 'lvalue'; $var}
166
167"a"->var = 45;
168
169print "# `$var' ne 45\nnot " unless $var eq 45;
170print "ok 23\n";
171
172my $oo;
173$o = bless \$oo, "a";
174
175$o->var = 47;
176
177print "# `$var' ne 47\nnot " unless $var eq 47;
178print "ok 24\n";
179
180sub o {use attrs 'lvalue'; $o}
181
182o->var = 49;
183
184print "# `$var' ne 49\nnot " unless $var eq 49;
185print "ok 25\n";
186
187sub nolv () { $x0, $x1 } # Not lvalue
188
189$_ = '';
190
191eval <<'EOE' or $_ = $@;
192 nolv = (2,3);
193 1;
194EOE
195
196print "not "
197 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
198print "ok 26\n";
199
200$_ = '';
201
202eval <<'EOE' or $_ = $@;
203 nolv = (2,3) if $_;
204 1;
205EOE
206
207print "not "
208 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
209print "ok 27\n";
210
211$_ = '';
212
213eval <<'EOE' or $_ = $@;
214 &nolv = (2,3) if $_;
215 1;
216EOE
217
218print "not "
219 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
220print "ok 28\n";
221
222$x0 = $x1 = $_ = undef;
223$nolv = \&nolv;
224
225eval <<'EOE' or $_ = $@;
226 $nolv->() = (2,3) if $_;
227 1;
228EOE
229
230print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
231print "ok 29\n";
232
233$x0 = $x1 = $_ = undef;
234$nolv = \&nolv;
235
236eval <<'EOE' or $_ = $@;
237 $nolv->() = (2,3);
238 1;
239EOE
240
241print "# '$_', '$x0', '$x1'.\nnot "
5c0bc887 242 unless /Can\'t modify non-lvalue subroutine call/;
cd06dffe
GS
243print "ok 30\n";
244
245sub lv0 {use attrs 'lvalue';} # Converted to lv10 in scalar context
246
247$_ = undef;
248eval <<'EOE' or $_ = $@;
249 lv0 = (2,3);
250 1;
251EOE
252
253print "# '$_'.\nnot "
254 unless /Can\'t return a readonly value from lvalue subroutine/;
255print "ok 31\n";
256
257sub lv10 {use attrs 'lvalue';}
258
259$_ = undef;
260eval <<'EOE' or $_ = $@;
261 (lv0) = (2,3);
262 1;
263EOE
264
265print "# '$_'.\nnot " if defined $_;
266print "ok 32\n";
267
268sub lv1u {use attrs 'lvalue'; undef }
269
270$_ = undef;
271eval <<'EOE' or $_ = $@;
272 lv1u = (2,3);
273 1;
274EOE
275
276print "# '$_'.\nnot "
277 unless /Can\'t return a readonly value from lvalue subroutine/;
278print "ok 33\n";
279
280$_ = undef;
281eval <<'EOE' or $_ = $@;
282 (lv1u) = (2,3);
283 1;
284EOE
285
286print "# '$_'.\nnot "
287 unless /Can\'t return an uninitialized value from lvalue subroutine/;
288print "ok 34\n";
289
290$x = '1234567';
291sub lv1t {use attrs 'lvalue'; index $x, 2 }
292
293$_ = undef;
294eval <<'EOE' or $_ = $@;
295 lv1t = (2,3);
296 1;
297EOE
298
299print "# '$_'.\nnot "
300 unless /Can\'t return a temporary from lvalue subroutine/;
301print "ok 35\n";
302
303$_ = undef;
304eval <<'EOE' or $_ = $@;
305 (lv1t) = (2,3);
306 1;
307EOE
308
309print "# '$_'.\nnot "
310 unless /Can\'t return a temporary from lvalue subroutine/;
311print "ok 36\n";
312
313$xxx = 'xxx';
314sub xxx () { $xxx } # Not lvalue
315sub lv1tmp {use attrs 'lvalue'; xxx } # is it a TEMP?
316
317$_ = undef;
318eval <<'EOE' or $_ = $@;
319 lv1tmp = (2,3);
320 1;
321EOE
322
323print "# '$_'.\nnot "
324 unless /Can\'t return a temporary from lvalue subroutine/;
325print "ok 37\n";
326
327$_ = undef;
328eval <<'EOE' or $_ = $@;
329 (lv1tmp) = (2,3);
330 1;
331EOE
332
333print "# '$_'.\nnot "
334 unless /Can\'t return a temporary from lvalue subroutine/;
335print "ok 38\n";
336
337sub xxx () { 'xxx' } # Not lvalue
338sub lv1tmpr {use attrs 'lvalue'; xxx } # is it a TEMP?
339
340$_ = undef;
341eval <<'EOE' or $_ = $@;
342 lv1tmpr = (2,3);
343 1;
344EOE
345
346print "# '$_'.\nnot "
347 unless /Can\'t return a readonly value from lvalue subroutine/;
348print "ok 39\n";
349
350$_ = undef;
351eval <<'EOE' or $_ = $@;
352 (lv1tmpr) = (2,3);
353 1;
354EOE
355
356print "# '$_'.\nnot "
357 unless /Can\'t return a readonly value from lvalue subroutine/;
358print "ok 40\n";
359
360=for disabled constructs
361
362sub lva {use attrs 'lvalue';@a}
363
364$_ = undef;
365@a = ();
366$a[1] = 12;
367eval <<'EOE' or $_ = $@;
368 (lva) = (2,3);
369 1;
370EOE
371
372print "# '$_'.\nnot "
373 unless /Can\'t return an uninitialized value from lvalue subroutine/;
374print "ok 41\n";
375
376$_ = undef;
377@a = ();
378$a[0] = undef;
379$a[1] = 12;
380eval <<'EOE' or $_ = $@;
381 (lva) = (2,3);
382 1;
383EOE
384
385print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
386print "ok 42\n";
387
388$_ = undef;
389@a = ();
390$a[0] = undef;
391$a[1] = 12;
392eval <<'EOE' or $_ = $@;
393 (lva) = (2,3);
394 1;
395EOE
396
397print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
398print "ok 43\n";
399
400=cut
401
402print "ok $_\n" for 41..43;
403
404sub lv1n {use attrs 'lvalue'; $newvar }
405
406$_ = undef;
407eval <<'EOE' or $_ = $@;
408 lv1n = (3,4);
409 1;
410EOE
411
412print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
413print "ok 44\n";
414
415sub lv1nn {use attrs 'lvalue'; $nnewvar }
416
417$_ = undef;
418eval <<'EOE' or $_ = $@;
419 (lv1nn) = (3,4);
420 1;
421EOE
422
423print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
424print "ok 45\n";
425
426$a = \&lv1nn;
427$a->() = 8;
428print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
429print "ok 46\n";