Commit | Line | Data |
9b657a62 |
1 | #!/usr/bin/perl -w |
2 | use strict; |
3 | use warnings; |
4 | use autodie::hints; |
5 | use Test::More; |
6 | |
7 | use constant PERL510 => ( $] >= 5.010 ); |
8 | |
9 | BEGIN { |
10 | if (not PERL510) { |
11 | plan skip_all => "Only subroutine hints supported in 5.8.x"; |
12 | } |
13 | else { |
14 | plan 'no_plan'; |
15 | } |
16 | } |
17 | |
18 | use FindBin; |
19 | use lib "$FindBin::Bin/lib"; |
20 | use Hints_pod_examples qw( |
21 | undef_scalar false_scalar zero_scalar empty_list default_list |
22 | empty_or_false_list undef_n_error_list foo re_fail bar |
23 | think_positive my_system |
24 | ); |
25 | use autodie qw( ! |
26 | undef_scalar false_scalar zero_scalar empty_list default_list |
27 | empty_or_false_list undef_n_error_list foo re_fail bar |
28 | think_positive my_system |
29 | ); |
30 | |
31 | my %scalar_tests = ( |
32 | |
33 | # Test code # Exception expected? |
34 | |
35 | 'undef_scalar()' => 1, |
36 | 'undef_scalar(1)', => 0, |
37 | 'undef_scalar(0)', => 0, |
38 | 'undef_scalar("")', => 0, |
39 | |
40 | 'false_scalar(0)', => 1, |
41 | 'false_scalar()', => 1, |
42 | 'false_scalar(undef)', => 1, |
43 | 'false_scalar("")', => 1, |
44 | 'false_scalar(1)', => 0, |
45 | 'false_scalar("1")', => 0, |
46 | |
47 | 'zero_scalar("0")', => 1, |
48 | 'zero_scalar(0)', => 1, |
49 | 'zero_scalar(1)', => 0, |
50 | 'zero_scalar(undef)', => 0, |
51 | 'zero_scalar("")', => 0, |
52 | |
53 | 'foo(0)', => 1, |
54 | 'foo(undef)', => 0, |
55 | 'foo(1)', => 0, |
56 | |
57 | 'bar(0)', => 1, |
58 | 'bar(undef)', => 0, |
59 | 'bar(1)', => 0, |
60 | |
61 | 're_fail(-1)', => 0, |
62 | 're_fail("FAIL")', => 1, |
63 | 're_fail("_FAIL")', => 1, |
64 | 're_fail("_fail")', => 0, |
65 | 're_fail("fail")', => 0, |
66 | |
67 | 'think_positive(-1)' => 1, |
68 | 'think_positive(-2)' => 1, |
69 | 'think_positive(0)' => 0, |
70 | 'think_positive(1)' => 0, |
71 | 'think_positive(2)' => 0, |
72 | |
73 | 'my_system(1)' => 1, |
74 | 'my_system(2)' => 1, |
75 | 'my_system(0)' => 0, |
76 | |
77 | ); |
78 | |
79 | my %list_tests = ( |
80 | |
81 | 'empty_list()', => 1, |
82 | 'empty_list(())', => 1, |
83 | 'empty_list([])', => 0, |
84 | 'empty_list(0)', => 0, |
85 | 'empty_list("")', => 0, |
86 | 'empty_list(undef)', => 0, |
87 | |
88 | 'default_list()', => 1, |
89 | 'default_list(0)', => 0, |
90 | 'default_list("")', => 0, |
91 | 'default_list(undef)', => 1, |
92 | 'default_list(1)', => 0, |
93 | 'default_list("str")', => 0, |
94 | 'default_list(1, 2)', => 0, |
95 | |
96 | 'empty_or_false_list()', => 1, |
97 | 'empty_or_false_list(())', => 1, |
98 | 'empty_or_false_list(0)', => 1, |
99 | 'empty_or_false_list(undef)',=> 1, |
100 | 'empty_or_false_list("")', => 1, |
101 | 'empty_or_false_list("0")', => 1, |
102 | 'empty_or_false_list(1,2)', => 0, |
103 | 'empty_or_false_list("a")', => 0, |
104 | |
105 | 'undef_n_error_list(undef, 1)' => 1, |
106 | 'undef_n_error_list(undef, "a")' => 1, |
107 | 'undef_n_error_list()' => 0, |
108 | 'undef_n_error_list(0, 1)' => 0, |
109 | 'undef_n_error_list("", 1)' => 0, |
110 | 'undef_n_error_list(1)' => 0, |
111 | |
112 | 'foo(0)', => 1, |
113 | 'foo(undef)', => 0, |
114 | 'foo(1)', => 0, |
115 | |
116 | 'bar(0)', => 1, |
117 | 'bar(undef)', => 0, |
118 | 'bar(1)', => 0, |
119 | |
120 | 're_fail(-1)', => 1, |
121 | 're_fail("FAIL")', => 0, |
122 | 're_fail("_FAIL")', => 0, |
123 | 're_fail("_fail")', => 0, |
124 | 're_fail("fail")', => 0, |
125 | |
126 | 'think_positive(-1)' => 1, |
127 | 'think_positive(-2)' => 1, |
128 | 'think_positive(0)' => 0, |
129 | 'think_positive(1)' => 0, |
130 | 'think_positive(2)' => 0, |
131 | |
132 | 'my_system(1)' => 1, |
133 | 'my_system(2)' => 1, |
134 | 'my_system(0)' => 0, |
135 | |
136 | ); |
137 | |
138 | # On Perl 5.8, autodie doesn't correctly propagate into string evals. |
139 | # The following snippet forces the use of autodie inside the eval if |
140 | # we really really have to. For 5.10+, we don't want to include this |
141 | # fix, because the tests will act as a canary if we screw up string |
142 | # eval propagation. |
143 | |
144 | my $perl58_fix = ( |
145 | PERL510 ? |
146 | q{} : |
147 | q{use autodie qw( |
148 | undef_scalar false_scalar zero_scalar empty_list default_list |
149 | empty_or_false_list undef_n_error_list foo re_fail bar |
150 | think_positive my_system bizarro_system |
151 | );} |
152 | ); |
153 | |
154 | # Some of the tests provide different hints for scalar or list context |
155 | |
156 | while (my ($test, $exception_expected) = each %scalar_tests) { |
157 | eval " |
158 | $perl58_fix |
159 | my \$scalar = $test; |
160 | "; |
161 | |
162 | if ($exception_expected) { |
163 | isnt("$@", "", "scalar test - $test"); |
164 | } |
165 | else { |
166 | is($@, "", "scalar test - $test"); |
167 | } |
168 | } |
169 | |
170 | while (my ($test, $exception_expected) = each %list_tests) { |
171 | eval " |
172 | $perl58_fix |
173 | my \@array = $test; |
174 | "; |
175 | |
176 | if ($exception_expected) { |
177 | isnt("$@", "", "array test - $test"); |
178 | } |
179 | else { |
180 | is($@, "", "array test - $test"); |
181 | } |
182 | } |
183 | |
184 | 1; |