]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/87-stress-uid.t
Require Module::ExtractUse 0.24 for the Kwalitee test
[perl/modules/Scope-Upper.git] / t / 87-stress-uid.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use Test::Leaner 'no_plan';
8
9 use Scope::Upper qw<uplevel uid validate_uid CALLER>;
10
11 my $max_level = 10;
12
13 our $inner_uplevels;
14
15 sub rec {
16  my $n      = shift;
17  my $level  = shift;
18  my $target = shift;
19  my @uids   = @_;
20
21  if ($n > 0) {
22   my @args = ($n - 1 => ($level, $target) => @uids);
23   if ($inner_uplevels) {
24    return uplevel {
25     rec(@args, uid());
26    };
27   } else {
28    return rec(@args, uid());
29   }
30  }
31
32  my $desc = "level=$level, target=$target, inner_uplevels=$inner_uplevels";
33
34  uplevel {
35   for my $i (1 .. $target) {
36    my $j = $level - $i;
37    ok !validate_uid($uids[$j]), "UID $j is invalid for $desc";
38   }
39   for my $i ($target + 1 .. $level) {
40    my $j = $level - $i;
41    ok validate_uid($uids[$j]), "UID $j is valid for $desc";
42   }
43  } CALLER($target);
44 }
45
46 {
47  local $inner_uplevels = 0;
48  for my $level (1 .. $max_level) {
49   for my $target (1 .. $level) {
50    rec($level => ($level, $target));
51   }
52  }
53 }
54
55 {
56  local $inner_uplevels = 1;
57  for my $level (1 .. $max_level) {
58   for my $target (1 .. $level) {
59    rec($level => ($level, $target));
60   }
61  }
62 }