t/70-uid-target.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 + 6 + 4 + 1 + 5;
   7
   8 use Scope::Upper qw<uid HERE UP>;
   9
  10 {
  11  local $@;
  12  eval {
  13   my $here = uid;
  14  };
  15  is $@, '', 'uid() does not croak';
  16 }
  17
  18 {
  19  local $@;
  20  eval {
  21   my $here = uid HERE;
  22  };
  23  is $@, '', 'uid(HERE) does not croak';
  24 }
  25
  26 {
  27  local $@;
  28  eval {
  29   my $up = uid UP;
  30  };
  31  is $@, '', 'uid(UP) does not croak';
  32 }
  33
  34 {
  35  my $here = uid;
  36  is $here, uid(),     '$here eq uid()';
  37  is $here, uid(HERE), '$here eq uid(HERE)';
  38  {
  39   is $here, uid(UP),  '$here eq uid(UP) (in block)';
  40  }
  41  sub {
  42   is $here, uid(UP),  '$here eq uid(UP) (in sub)';
  43  }->();
  44  local $@;
  45  eval {
  46   is $here, uid(UP),  '$here eq uid(UP) (in eval block)';
  47  };
  48  eval q{
  49   is $here, uid(UP),  '$here eq uid(UP) (in eval string)';
  50  };
  51 }
  52
  53 {
  54  my $here;
  55  {
  56   {
  57    $here = uid(UP);
  58    isnt $here, uid(), 'uid(UP) != uid(HERE)';
  59   }
  60   is $here, uid(), '$here defined in an older block is now OK';
  61  }
  62  isnt $here, uid(), '$here defined in an older block is no longer OK';
  63  {
  64   isnt $here, uid(), '$here defined in an older block has been overwritten';
  65  }
  66 }
  67
  68 {
  69  my $first;
  70  for (1, 2) {
  71   if ($_ == 1) {
  72    $first = uid();
  73   } else {
  74    isnt $first, uid(), 'a new UID for each loop iteration';
  75   }
  76  }
  77 }
  78
  79 {
  80  my $top;
  81  my $uid;
  82
  83  sub Scope::Upper::TestUIDDestructor::DESTROY {
  84   $uid = uid;
  85   isnt $uid, $top, '$uid is not the outside UID';
  86   {
  87    is uid(UP), $uid, 'uid(UP) in block in destructor is correct';
  88   }
  89  }
  90
  91  {
  92   my $guard = bless [], 'Scope::Upper::TestUIDDestructor';
  93   $top = uid;
  94  }
  95  isnt $uid, undef, '$uid was set in the destructor';
  96
  97  {
  98   isnt $uid, uid(), '$uid is no longer valid (in block)';
  99   sub {
 100    isnt $uid, uid(), '$uid is no longer valid (in sub in block)';
 101   }->();
 102  }
 103 }