]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/67-uplevel-scope.t
Add braces around a condition block
[perl/modules/Scope-Upper.git] / t / 67-uplevel-scope.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 2 + 2 * 6 + 3 * 2;
7
8 use Scope::Upper qw<uplevel HERE UP>;
9
10 {
11  our $x = 1;
12  sub {
13   local $x = 2;
14   sub {
15    local $x = 3;
16    uplevel { is $x, 3, 'global variables scoping 1' } HERE;
17   }->();
18  }->();
19 }
20
21 {
22  our $x = 4;
23  sub {
24   local $x = 5;
25   sub {
26    local $x = 6;
27    uplevel { is $x, 6, 'global variables scoping 2' } UP;
28   }->();
29  }->();
30 }
31
32 sub {
33  'abc' =~ /(.)/;
34  is $1, 'a', 'match variables scoping 1: before 1';
35  sub {
36   'uvw' =~ /(.)/;
37   is $1, 'u', 'match variables scoping 1: before 2';
38   uplevel {
39    is $1, 'u', 'match variables scoping 1: before 3';
40    'xyz' =~ /(.)/;
41    is $1, 'x', 'match variables scoping 1: after 1';
42   } HERE;
43   is $1, 'u', 'match variables scoping 1: after 2';
44  }->();
45  is $1, 'a', 'match variables scoping 1: after 3';
46 }->();
47
48 sub {
49  'abc' =~ /(.)/;
50  is $1, 'a', 'match variables scoping 2: before 1';
51  sub {
52   'uvw' =~ /(.)/;
53   is $1, 'u', 'match variables scoping 2: before 2';
54   uplevel {
55    is $1, 'u', 'match variables scoping 2: before 3';
56    'xyz' =~ /(.)/;
57    is $1, 'x', 'match variables scoping 2: after 1';
58   } UP;
59   is $1, 'u', 'match variables scoping 2: after 2';
60  }->();
61  is $1, 'a', 'match variables scoping 2: after 3';
62 }->();
63
64 SKIP: {
65  skip 'No state variables before perl 5.10' => 3 * 2 unless "$]" >= 5.010;
66
67  my $desc = 'state variables';
68
69  {
70   local $@;
71   eval 'use feature "state"; sub herp { state $id = 123; return ++$id }';
72   die $@ if $@;
73  }
74
75  sub derp {
76   sub {
77    &uplevel(\&herp => UP);
78   }->();
79  }
80
81  for my $run (1 .. 3) {
82   local $@;
83   my $ret = eval {
84    derp()
85   };
86   is $@,   '',         "$desc: run $run did not croak";
87   is $ret, 123 + $run, "$desc: run $run returned the correct value";
88  }
89 }