This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to assertions-0.03
[perl5.git] / t / comp / assertions.t
1 #!./perl
2
3 BEGIN { $^W=0 }
4
5 use base 'assertions::compat';
6
7 sub callme ($ ) : assertion {
8     return shift;
9 }
10
11 # select STDERR; $|=1;
12
13 my @expr=( '1' => 1,
14            '0' => 0,
15            '1 && 1' => 1,
16            '1 && 0' => 0,
17            '0 && 1' => 0,
18            '0 && 0' => 0,
19            '1 || 1' => 1,
20            '1 || 0' => 1,
21            '0 || 1' => 1,
22            '0 || 0' => 0,
23            '(1)' => 1,
24            '(0)' => 0,
25            '1 && ((1) && 1)' => 1,
26            '1 && (0 || 1)' => 1,
27            '1 && ( 0' => undef,
28            '1 &&' => undef,
29            '&& 1' => undef,
30            '1 && || 1' => undef,
31            '(1 && 1) && 1)' => undef,
32            'one && two' => 1,
33            '_ && one' => 0,
34            'one && three' => 0,
35            '1 ' => 1,
36            ' 1' => 1,
37            ' 1 ' => 1,
38            ' ( 1 && 1 ) ' => 1,
39            ' ( 1 && 0 ) ' => 0,
40            '(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 );
41
42 my $supported = assertions::compat::supported();
43
44 my $n=@expr/2 + ($supported ? 10 : 0);
45 my $i=1;
46 print "1..$n\n";
47
48 use assertions::activate 'one', 'two';
49 require assertions;
50
51 while (@expr) {
52     my $expr=shift @expr;
53     my $expected=shift @expr;
54     my $result=eval {assertions::_calc_expr($expr)};
55     if (defined $expected) {
56         unless (defined $result and $result == $expected) {
57             print STDERR "assertions::_calc_expr($expr) failed,".
58                 " expected '$expected' but '$result' obtained (\$@=$@)\n";
59             print "not ";
60         }
61     }
62     else {
63         if (defined $result) {
64             print STDERR "assertions::_calc_expr($expr) failed,".
65                 " expected undef but '$result' obtained\n";
66             print "not ";
67         }
68     }
69     print "ok ", $i++, "\n";
70 }
71
72 if ($supported) {
73
74     # @expr/2+1
75     if (callme(1)) {
76         print STDERR "assertions called by default\n";
77         print "not ";
78     }
79     print "ok ", $i++, "\n";
80     
81     # 2
82     use assertions::activate 'mine';
83     {
84         package mine;
85         use base 'assertions::compat';
86         sub callme ($) : assertion {
87             return shift;
88         }
89             use assertions;
90         unless (callme(1)) {
91             print STDERR "'use assertions;' doesn't active assertions based on package name\n";
92             print "not ";
93         }
94     }
95     print "ok ", $i++, "\n";
96     
97     # 3
98     use assertions 'foo';
99     if (callme(1)) {
100         print STDERR "assertion deselection doesn't work\n";
101         print "not ";
102     }
103     print "ok ", $i++, "\n";
104     
105     # 4
106     use assertions::activate 'bar', 'doz';
107     use assertions 'bar';
108     unless (callme(1)) {
109         print STDERR "assertion selection doesn't work\n";
110         print "not ";
111     }
112     print "ok ", $i++, "\n";
113     
114     # 5
115     use assertions q(_ && doz);
116     unless (callme(1)) {
117         print STDERR "assertion activation filtering doesn't work\n";
118         print "not ";
119     }
120     print "ok ", $i++, "\n";
121     
122     # 6
123     use assertions q(_ && foo);
124     if (callme(1)) {
125         print STDERR "assertion deactivation filtering doesn't work\n";
126         print "not ";
127     }
128     print "ok ", $i++, "\n";
129     
130     # 7
131     if (1) {
132         use assertions 'bar';
133     }
134     if (callme(1)) {
135         print STDERR "assertion scoping doesn't work\n";
136         print "not ";
137     }
138     print "ok ", $i++, "\n";
139
140     # 8
141     use assertions::activate 're.*';
142     use assertions 'reassert';
143     unless (callme(1)) {
144         print STDERR "assertion selection with re failed\n";
145         print "not ";
146     }
147     print "ok ", $i++, "\n";
148
149     # 9
150     my $b=12;
151     {
152         use assertions 'bar';
153         callme(my $b=45);
154         unless ($b == 45) {
155             print STDERR "this shouldn't fail ever (b=$b)\n";
156             print "not ";
157         }
158     }
159     print "ok ", $i++, "\n";
160
161     # 10
162     {
163         no assertions;
164         callme(my $b=46);
165         if (defined $b) {
166             print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
167             print "not ";
168         }
169     }
170     print "ok ", $i++, "\n";
171 }