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 }