perldelta: perldelta for previous commit
[perl.git] / t / op / wantarray.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use strict;
10
11 plan 28;
12
13 sub context {
14   local $::Level = $::Level + 1;
15   my ( $cona, $name ) = @_;
16   my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
17   is $conb, $cona, $name;
18 }
19
20 context('V');
21 my $a = context('S');
22 my @a = context('A');
23 scalar context('S');
24 $a = scalar context('S');
25 ($a) = context('A');
26 ($a) = scalar context('S');
27
28 {
29   # [ID 20020626.011 (#9998)] incorrect wantarray optimisation
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();
37   is @b, 1;
38   is "@b", "2";
39   is $c, 2;
40 }
41
42 my $q;
43
44 my $qcontext = q{
45   $q = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
46 };
47 eval $qcontext;
48 is $q, 'V';
49 $a = eval $qcontext;
50 is $q, 'S';
51 @a = eval $qcontext;
52 is $q, 'A';
53
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;
59 sub or_context { $::f || context(shift, "rhs of || at sub exit") }
60 or_context('V');
61 $_ = or_context('S');
62 () = or_context('A');
63 sub and_context { $::t && context(shift, "rhs of && at sub exit") }
64 and_context('V');
65 $_ = and_context('S');
66 () = and_context('A');
67 sub dor_context { $::u // context(shift, "rhs of // at sub exit") }
68 dor_context('V');
69 $_ = dor_context('S');
70 () = dor_context('A');
71 sub cond_middle_cx { $::t ? context(shift, "mid of ?: at sub exit") : 0 }
72 cond_middle_cx('V');
73 $_ = cond_middle_cx('S');
74 () = cond_middle_cx('A');
75 sub cond_rhs_cx { $::f ? 0 : context(shift, "rhs of ?: at sub exit") }
76 cond_rhs_cx('V');
77 $_ = cond_rhs_cx('S');
78 () = cond_rhs_cx('A');
79
80 1;