t/55-yield-target.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7
   8 use Scope::Upper qw<yield leave>;
   9
  10 my @res;
  11
  12 @res = (0, eval {
  13  yield;
  14  1;
  15 }, 2);
  16 is $@, '', 'yield() does not croak';
  17 is_deeply \@res, [ 0, 2 ], 'yield() in eval { ... }';
  18
  19 @res = (3, eval "
  20  yield;
  21  4;
  22 ", 5);
  23 is $@, '', 'yield() does not croak';
  24 is_deeply \@res, [ 3, 5 ], 'yield() in eval "..."';
  25
  26 @res = (6, sub {
  27  yield;
  28  7;
  29 }->(), 8);
  30 is_deeply \@res, [ 6, 8 ], 'yield() in sub { ... }';
  31
  32 @res = (9, do {
  33  yield;
  34  10;
  35 }, 11);
  36 is_deeply \@res, [ 9, 11 ], 'yield() in do { ... }';
  37
  38 @res = (12, (map {
  39  yield;
  40  13;
  41 } qw<a b c>), 14);
  42 is_deeply \@res, [ 12, 14 ], 'yield() in map { ... }';
  43
  44 my $loop;
  45 @res = (15, do {
  46  for (16, 17) {
  47   $loop = $_;
  48   yield;
  49   my $x = 18;
  50  }
  51 }, 19);
  52 is $loop, 16, 'yield() exited for';
  53 is_deeply \@res, [ 15, 19 ], 'yield() in for () { ... }';
  54
  55 @res = (20, do {
  56  $loop = 21;
  57  while ($loop) {
  58   yield;
  59   $loop = 0;
  60   my $x = 22;
  61  }
  62 }, 23);
  63 is $loop, 21, 'yield() exited while';
  64 is_deeply \@res, [ 20, 23 ], 'yield() in while () { ... }';
  65
  66 SKIP: {
  67  skip '"eval { $str =~ s/./die q[foo]/e }" breaks havoc on perl 5.8 and below'
  68                                                            => 1 if "$]" < 5.010;
  69  my $s = 'a';
  70  local $@;
  71  eval {
  72   $s =~ s/./yield; die 'not reached'/e;
  73  };
  74  my $err  = $@;
  75  my $line = __LINE__-3;
  76  like $err,
  77       qr/^yield\(\) can't target a substitution context at \Q$0\E line $line/,
  78       'yield() cannot exit subst';
  79 }
  80
  81 SKIP: {
  82  skip 'perl 5.10 is required to test interaction with given/when' => 6
  83                                                                 if "$]" < 5.010;
  84
  85  @res = eval <<'TESTCASE';
  86   BEGIN {
  87    if ("$]" >= 5.017_011) {
  88     require warnings;
  89     warnings->unimport('experimental::smartmatch');
  90    }
  91   }
  92   use feature 'switch';
  93   (24, do {
  94    given (25) {
  95     yield;
  96     my $x = 26;
  97    }
  98   }, 27);
  99 TESTCASE
 100  diag $@ if $@;
 101  is_deeply \@res, [ 24, 27 ], 'yield() in given { }';
 102
 103  # Beware that calling yield() in when() in given() sends us directly at the
 104  # end of the enclosing given block.
 105  @res = ();
 106  eval <<'TESTCASE';
 107   BEGIN {
 108    if ("$]" >= 5.017_011) {
 109     require warnings;
 110     warnings->unimport('experimental::smartmatch');
 111    }
 112   }
 113   use feature 'switch';
 114   @res = (28, do {
 115    given (29) {
 116     when (29) {
 117      yield;
 118      die 'not reached 1';
 119     }
 120     die 'not reached 2';
 121    }
 122   }, 30)
 123 TESTCASE
 124  is $@, '', 'yield() in when { } in given did not croak';
 125  is_deeply \@res, [ 28, 30 ], 'yield() in when { } in given';
 126
 127  # But calling yield() in when() in for() sends us at the next iteration.
 128  @res = ();
 129  eval <<'TESTCASE';
 130   BEGIN {
 131    if ("$]" >= 5.017_011) {
 132     require warnings;
 133     warnings->unimport('experimental::smartmatch');
 134    }
 135   }
 136   use feature 'switch';
 137   @res = (31, do {
 138    for (32, 33) {
 139     $loop = $_;
 140     when (32) {
 141      yield;
 142      die 'not reached 3';
 143      my $x = 34;
 144     }
 145     when (33) {
 146      yield;
 147      die 'not reached 4';
 148      my $x = 35;
 149     }
 150     die 'not reached 5';
 151     my $x = 36;
 152    }
 153   }, 37)
 154 TESTCASE
 155  is $@, '', 'yield() in for { } in given did not croak';
 156  is $loop, 33, 'yield() exited for on the second iteration';
 157  # A loop exited by last() evaluates to an empty list, but a loop that reached
 158  # its natural end evaluates to false!
 159  is_deeply \@res, [ 31, '', 37 ], 'yield() in when { }';
 160 }