]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/55-yield-target.t
Also warn when SUB() and EVAL() cannot find an appropriate target
[perl/modules/Scope-Upper.git] / 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 }