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;