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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#!./perl
sub callme ($ ) : assertion {
return shift;
}
# select STDERR; $|=1;
my @expr=( '1' => 1,
'0' => 0,
'1 && 1' => 1,
'1 && 0' => 0,
'0 && 1' => 0,
'0 && 0' => 0,
'1 || 1' => 1,
'1 || 0' => 1,
'0 || 1' => 1,
'0 || 0' => 0,
'(1)' => 1,
'(0)' => 0,
'1 && ((1) && 1)' => 1,
'1 && (0 || 1)' => 1,
'1 && ( 0' => undef,
'1 &&' => undef,
'&& 1' => undef,
'1 && || 1' => undef,
'(1 && 1) && 1)' => undef,
'one && two' => 1,
'_ && one' => 0,
'one && three' => 0,
'1 ' => 1,
' 1' => 1,
' 1 ' => 1,
' ( 1 && 1 ) ' => 1,
' ( 1 && 0 ) ' => 0,
'(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 );
my $n=@expr/2+10;
my $i=1;
print "1..$n\n";
use assertions::activate 'one', 'two';
require assertions;
while (@expr) {
my $expr=shift @expr;
my $expected=shift @expr;
my $result=eval {assertions::calc_expr($expr)};
if (defined $expected) {
unless (defined $result and $result == $expected) {
print STDERR "assertions::calc_expr($expr) failed,".
" expected '$expected' but '$result' obtained (\$@=$@)\n";
print "not ";
}
}
else {
if (defined $result) {
print STDERR "assertions::calc_expr($expr) failed,".
" expected undef but '$result' obtained\n";
print "not ";
}
}
print "ok ", $i++, "\n";
}
# @expr/2+1
if (callme(1)) {
print STDERR "assertions called by default\n";
print "not ";
}
print "ok ", $i++, "\n";
# 2
use assertions::activate 'mine';
{
package mine;
sub callme ($) : assertion {
return shift;
}
use assertions;
unless (callme(1)) {
print STDERR "'use assertions;' doesn't active assertions based on package name\n";
print "not ";
}
}
print "ok ", $i++, "\n";
# 3
use assertions 'foo';
if (callme(1)) {
print STDERR "assertion deselection doesn't work\n";
print "not ";
}
print "ok ", $i++, "\n";
# 4
use assertions::activate 'bar', 'doz';
use assertions 'bar';
unless (callme(1)) {
print STDERR "assertion selection doesn't work\n";
print "not ";
}
print "ok ", $i++, "\n";
# 5
use assertions q(_ && doz);
unless (callme(1)) {
print STDERR "assertion activation filtering doesn't work\n";
print "not ";
}
print "ok ", $i++, "\n";
# 6
use assertions q(_ && foo);
if (callme(1)) {
print STDERR "assertion deactivation filtering doesn't work\n";
print "not ";
}
print "ok ", $i++, "\n";
# 7
if (1) {
use assertions 'bar';
}
if (callme(1)) {
print STDERR "assertion scoping doesn't work\n";
print "not ";
}
print "ok ", $i++, "\n";
# 8
use assertions::activate 're.*';
use assertions 'reassert';
unless (callme(1)) {
print STDERR "assertion selection with re failed\n";
print "not ";
}
print "ok ", $i++, "\n";
# 9
my $b=12;
{
use assertions 'bar';
callme(my $b=45);
unless ($b == 45) {
print STDERR "this shouldn't fail ever (b=$b)\n";
print "not ";
}
}
print "ok ", $i++, "\n";
# 10
{
no assertions;
callme(my $b=46);
if (defined $b) {
print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
print "not ";
}
}
print "ok ", $i++, "\n";
|
