]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/70-uid-target.t
Make sure the code snippets fit in 80-columns wide terminal
[perl/modules/Scope-Upper.git] / 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 }