6 use Test::More tests => 2 * 32 + 2 * 21;
8 use Scope::Upper qw<uplevel uid validate_uid UP>;
13 my $there = "in the sub above the target (run $run)";
15 my $uplevel_uid = sub {
17 my $there = "in the target sub (run $run)";
19 my $uplevel_uid = sub {
20 my $between_uid = uid;
21 my $there = "in the sub between the target and the source (run $run)";
23 my $uplevel_uid = sub {
25 my $there = "in the source sub (run $run)";
27 my $uplevel_uid = uplevel {
28 my $uplevel_uid = uid;
29 my $there = "in the uplevel callback (run $run)";
30 my $invalid = 'temporarily invalid';
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";
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";
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";
52 is uid(UP), $above_uid, "uid(UP) == \$above_uid $there";
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";
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";
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";
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";
86 my $there = "in a new sub at replacing the target";
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";
91 isnt $here, $uplevel_uid, "\$here != \$uplevel_uid $there";
93 is uid(UP), $above_uid, "uid(UP) == \$above_uid $there";
101 my $there = "in the first sub (run $run)";
102 my $invalid = 'temporarily invalid';
105 my $first_uplevel = uid;
106 my $there = "in the first uplevel (run $run)";
108 ok !validate_uid($first_sub), "\$first_sub is $invalid $there";
109 ok validate_uid($first_uplevel), "\$first_uplevel is valid $there";
111 isnt $first_uplevel, $first_sub, "\$first_uplevel != \$first_sub $there";
112 isnt uid(UP), $first_sub, "uid(UP) != \$first_sub $there";
114 my ($second_sub, $second_uplevel) = sub {
115 my $second_sub = uid;
116 my $there = "in the second sub (run $run)";
118 my $second_uplevel = uplevel {
119 my $second_uplevel = uid;
120 my $there = "in the second uplevel (run $run)";
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";
127 isnt $second_uplevel, $second_sub,
128 "\$second_uplevel != \$second_sub $there";
129 is uid(UP), $first_uplevel, "uid(UP) == \$first_uplevel $there";
131 return $second_uplevel;
134 return $second_sub, $second_uplevel;
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";
143 my $third_uplevel = uid;
144 my $there = "in the third uplevel (run $run)";
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";
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";