This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Follow-up on a149d118.
[perl5.git] / t / op / wantarray.t
CommitLineData
1d0ef875
NA
1#!./perl
2
dab34d0f
NC
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9use strict;
10
199268fb 11plan 28;
dab34d0f 12
1d0ef875 13sub context {
dab34d0f 14 local $::Level = $::Level + 1;
199268fb 15 my ( $cona, $name ) = @_;
1d0ef875 16 my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
54408af4 17 is $conb, $cona, $name;
1d0ef875
NA
18}
19
dab34d0f
NC
20context('V');
21my $a = context('S');
22my @a = context('A');
23scalar context('S');
24$a = scalar context('S');
25($a) = context('A');
26($a) = scalar context('S');
d2ccd3cb
HS
27
28{
ee95e30c 29 # [ID 20020626.011 (#9998)] incorrect wantarray optimisation
d2ccd3cb
HS
30 sub simple { wantarray ? 1 : 2 }
31 sub inline {
32 my $a = wantarray ? simple() : simple();
33 $a;
34 }
35 my @b = inline();
36 my $c = inline();
dab34d0f
NC
37 is @b, 1;
38 is "@b", "2";
39 is $c, 2;
d2ccd3cb
HS
40}
41
dab34d0f
NC
42my $q;
43
cc37eb0b
RGS
44my $qcontext = q{
45 $q = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
46};
47eval $qcontext;
dab34d0f 48is $q, 'V';
cc37eb0b 49$a = eval $qcontext;
dab34d0f 50is $q, 'S';
cc37eb0b 51@a = eval $qcontext;
dab34d0f 52is $q, 'A';
cc37eb0b 53
199268fb
FC
54# Test with various ops that the right context is used at the end of a sub-
55# routine (run-time context).
56$::t = 1;
57$::f = 0;
58$::u = undef;
59sub or_context { $::f || context(shift, "rhs of || at sub exit") }
60or_context('V');
61$_ = or_context('S');
62() = or_context('A');
63sub and_context { $::t && context(shift, "rhs of && at sub exit") }
64and_context('V');
65$_ = and_context('S');
66() = and_context('A');
67sub dor_context { $::u // context(shift, "rhs of // at sub exit") }
68dor_context('V');
69$_ = dor_context('S');
70() = dor_context('A');
71sub cond_middle_cx { $::t ? context(shift, "mid of ?: at sub exit") : 0 }
72cond_middle_cx('V');
73$_ = cond_middle_cx('S');
74() = cond_middle_cx('A');
75sub cond_rhs_cx { $::f ? 0 : context(shift, "rhs of ?: at sub exit") }
76cond_rhs_cx('V');
77$_ = cond_rhs_cx('S');
78() = cond_rhs_cx('A');
79
1d0ef875 801;