Commit | Line | Data |
---|---|---|
1d0ef875 NA |
1 | #!./perl |
2 | ||
dab34d0f NC |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
dab34d0f | 5 | require './test.pl'; |
624c42e2 | 6 | set_up_inc('../lib'); |
dab34d0f NC |
7 | } |
8 | ||
9 | use strict; | |
10 | ||
199268fb | 11 | plan 28; |
dab34d0f | 12 | |
1d0ef875 | 13 | sub 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 |
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'); | |
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 |
42 | my $q; |
43 | ||
cc37eb0b RGS |
44 | my $qcontext = q{ |
45 | $q = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V'; | |
46 | }; | |
47 | eval $qcontext; | |
dab34d0f | 48 | is $q, 'V'; |
cc37eb0b | 49 | $a = eval $qcontext; |
dab34d0f | 50 | is $q, 'S'; |
cc37eb0b | 51 | @a = eval $qcontext; |
dab34d0f | 52 | is $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; | |
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 | ||
1d0ef875 | 80 | 1; |