]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/75-uid-uplevel.t
Make sure the code snippets fit in 80-columns wide terminal
[perl/modules/Scope-Upper.git] / t / 75-uid-uplevel.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 2 * 32 + 2 * 21;
7
8 use Scope::Upper qw<uplevel uid validate_uid UP>;
9
10 for my $run (1, 2) {
11  sub {
12   my $above_uid = uid;
13   my $there     = "in the sub above the target (run $run)";
14
15   my $uplevel_uid = sub {
16    my $target_uid = uid;
17    my $there      = "in the target sub (run $run)";
18
19    my $uplevel_uid = sub {
20     my $between_uid = uid;
21     my $there       = "in the sub between the target and the source (run $run)";
22
23     my $uplevel_uid = sub {
24      my $source_uid = uid;
25      my $there      = "in the source sub (run $run)";
26
27      my $uplevel_uid = uplevel {
28       my $uplevel_uid = uid;
29       my $there       = "in the uplevel callback (run $run)";
30       my $invalid     = 'temporarily invalid';
31
32       ok  validate_uid($uplevel_uid), "\$uplevel_uid is valid $there";
33       ok !validate_uid($source_uid),  "\$source_uid is $invalid $there";
34       ok !validate_uid($between_uid), "\$between_uid is $invalid $there";
35       ok !validate_uid($target_uid),  "\$target_uid is $invalid $there";
36       ok  validate_uid($above_uid),   "\$above_uid is valid $there";
37
38       isnt $uplevel_uid, $source_uid,  "\$uplevel_uid != \$source_uid $there";
39       isnt $uplevel_uid, $between_uid, "\$uplevel_uid != \$between_uid $there";
40       isnt $uplevel_uid, $target_uid,  "\$uplevel_uid != \$target_uid $there";
41       isnt $uplevel_uid, $above_uid,   "\$uplevel_uid != \$above_uid $there";
42
43       {
44        my $here = uid;
45
46        isnt $here, $source_uid,  "\$here != \$source_uid in block $there";
47        isnt $here, $between_uid, "\$here != \$between_uid in block $there";
48        isnt $here, $target_uid,  "\$here != \$target_uid in block $there";
49        isnt $here, $above_uid,   "\$here != \$above_uid in block $there";
50       }
51
52       is uid(UP), $above_uid, "uid(UP) == \$above_uid $there";
53
54       return $uplevel_uid;
55      } UP UP;
56
57      ok !validate_uid($uplevel_uid), "\$uplevel_uid is no longer valid $there";
58      ok  validate_uid($source_uid),  "\$source_uid is valid again $there";
59      ok  validate_uid($between_uid), "\$between_uid is valid again $there";
60      ok  validate_uid($target_uid),  "\$target_uid is valid again $there";
61      ok  validate_uid($above_uid),   "\$above_uid is still valid $there";
62
63      return $uplevel_uid;
64     }->();
65
66     ok !validate_uid($uplevel_uid), "\$uplevel_uid is no longer valid $there";
67     ok  validate_uid($between_uid), "\$between_uid is valid again $there";
68     ok  validate_uid($target_uid),  "\$target_uid is valid again $there";
69     ok  validate_uid($above_uid),   "\$above_uid is still valid $there";
70
71     return $uplevel_uid;
72    }->();
73
74    ok !validate_uid($uplevel_uid), "\$uplevel_uid is no longer valid $there";
75    ok  validate_uid($target_uid),  "\$target_uid is valid again $there";
76    ok  validate_uid($above_uid),   "\$above_uid is still valid $there";
77
78    return $uplevel_uid;
79   }->();
80
81   ok !validate_uid($uplevel_uid), "\$uplevel_uid is no longer valid $there";
82   ok  validate_uid($above_uid),   "\$above_uid is still valid $there";
83
84   sub {
85    my $here  = uid;
86    my $there = "in a new sub at replacing the target";
87
88    ok !validate_uid($uplevel_uid), "\$uplevel_uid is no longer valid $there";
89    ok  validate_uid($above_uid),   "\$above_uid is still valid $there";
90
91    isnt $here, $uplevel_uid, "\$here != \$uplevel_uid $there";
92
93    is   uid(UP), $above_uid, "uid(UP) == \$above_uid $there";
94   }->();
95  }->();
96 }
97
98 for my $run (1, 2) {
99  sub {
100   my $first_sub = uid;
101   my $there     = "in the first sub (run $run)";
102   my $invalid   = 'temporarily invalid';
103
104   uplevel {
105    my $first_uplevel = uid;
106    my $there         = "in the first uplevel (run $run)";
107
108    ok !validate_uid($first_sub),     "\$first_sub is $invalid $there";
109    ok  validate_uid($first_uplevel), "\$first_uplevel is valid $there";
110
111    isnt $first_uplevel, $first_sub, "\$first_uplevel != \$first_sub $there";
112    isnt uid(UP),        $first_sub, "uid(UP) != \$first_sub $there";
113
114    my ($second_sub, $second_uplevel) = sub {
115     my $second_sub = uid;
116     my $there      = "in the second sub (run $run)";
117
118     my $second_uplevel = uplevel {
119      my $second_uplevel = uid;
120      my $there          = "in the second uplevel (run $run)";
121
122      ok !validate_uid($first_sub),      "\$first_sub is $invalid $there";
123      ok  validate_uid($first_uplevel),  "\$first_uplevel is valid $there";
124      ok !validate_uid($second_sub),     "\$second_sub is $invalid $there";
125      ok  validate_uid($second_uplevel), "\$second_uplevel is valid $there";
126
127      isnt $second_uplevel, $second_sub,
128                                       "\$second_uplevel != \$second_sub $there";
129      is   uid(UP),         $first_uplevel,  "uid(UP) == \$first_uplevel $there";
130
131      return $second_uplevel;
132     };
133
134     return $second_sub, $second_uplevel;
135    }->();
136
137    ok  validate_uid($first_uplevel),    "\$first_uplevel is still valid $there";
138    ok !validate_uid($second_sub),      "\$second_sub is no longer valid $there";
139    ok !validate_uid($second_uplevel),
140                                    "\$second_uplevel is no longer valid $there";
141
142    uplevel {
143     my $third_uplevel = uid;
144     my $there         = "in the third uplevel (run $run)";
145
146     ok !validate_uid($first_uplevel),      "\$first_uplevel is $invalid $there";
147     ok !validate_uid($second_sub),     "\$second_sub is no longer valid $there";
148     ok !validate_uid($second_uplevel),
149                                    "\$second_uplevel is no longer valid $there";
150     ok  validate_uid($third_uplevel),         "\$third_uplevel is valid $there";
151
152     isnt $third_uplevel, $first_uplevel,
153                                     "\$third_uplevel != \$first_uplevel $there";
154     isnt $third_uplevel, $second_sub,  "\$third_uplevel != \$second_sub $there";
155     isnt $third_uplevel, $second_uplevel,
156                                    "\$third_uplevel != \$second_uplevel $there";
157     isnt uid(UP), $first_sub, "uid(UP) != \$first_sub $there";
158    }
159   }
160  }->();
161 }