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