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>;
   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 {
  67  my $s = 'a';
  68  local $@;
  69  eval {
  70   $s =~ s/./yield; die 'not reached'/e;
  71  };
  72  my $err  = $@;
  73  my $line = __LINE__-3;
  74  like $err,
  75       qr/^yield\(\) cannot target a substitution context at \Q$0\E line $line/,
  76       'yield() cannot exit subst';
  77 }
  78
  79 SKIP: {
  80  skip 'perl 5.10 is required to test interaction with given/when' => 6
  81                                                                 if "$]" < 5.010;
  82
  83  @res = eval <<'TESTCASE';
  84   use feature 'switch';
  85   (24, do {
  86    given (25) {
  87     yield;
  88     my $x = 26;
  89    }
  90   }, 27);
  91 TESTCASE
  92  diag $@ if $@;
  93  is_deeply \@res, [ 24, 27 ], 'yield() in given { }';
  94
  95  # Beware that calling yield() in when() in given() sends us directly at the
  96  # end of the enclosing given block.
  97  @res = ();
  98  eval <<'TESTCASE';
  99   use feature 'switch';
 100   @res = (28, do {
 101    given (29) {
 102     when (29) {
 103      yield;
 104      die 'not reached 1';
 105     }
 106     die 'not reached 2';
 107    }
 108   }, 30)
 109 TESTCASE
 110  is $@, '', 'yield() in when { } in given did not croak';
 111  is_deeply \@res, [ 28, 30 ], 'yield() in when { } in given';
 112
 113  # But calling yield() in when() in for() sends us at the next iteration.
 114  @res = ();
 115  eval <<'TESTCASE';
 116   use feature 'switch';
 117   @res = (31, do {
 118    for (32, 33) {
 119     $loop = $_;
 120     when (32) {
 121      yield;
 122      die 'not reached 3';
 123      my $x = 34;
 124     }
 125     when (33) {
 126      yield;
 127      die 'not reached 4';
 128      my $x = 35;
 129     }
 130     die 'not reached 5';
 131     my $x = 36;
 132    }
 133   }, 37)
 134 TESTCASE
 135  is $@, '', 'yield() in for { } in given did not croak';
 136  is $loop, 33, 'yield() exited for on the second iteration';
 137  # A loop exited by last() evaluates to an empty list, but a loop that reached
 138  # its natural end evaluates to false!
 139  is_deeply \@res, [ 31, '', 37 ], 'yield() in when { }';
 140 }