Commit | Line | Data |
---|---|---|
54310121 | 1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
54310121 | 6 | } |
7 | ||
9f1b1f2d | 8 | use warnings; |
54310121 | 9 | use vars qw{ @warnings }; |
10 | BEGIN { # ...and save 'em for later | |
11 | $SIG{'__WARN__'} = sub { push @warnings, @_ } | |
12 | } | |
803b07a7 | 13 | END { print STDERR @warnings } |
54310121 | 14 | |
54310121 | 15 | |
16 | use strict; | |
10a0e555 HS |
17 | use Test::More tests => 74; |
18 | my $TB = Test::More->builder; | |
19 | ||
20 | BEGIN { use_ok('constant'); } | |
54310121 | 21 | |
22 | sub test ($$;$) { | |
23 | my($num, $bool, $diag) = @_; | |
24 | if ($bool) { | |
25 | print "ok $num\n"; | |
26 | return; | |
27 | } | |
28 | print "not ok $num\n"; | |
29 | return unless defined $diag; | |
30 | $diag =~ s/\Z\n?/\n/; # unchomp | |
31 | print map "# $num : $_", split m/^/m, $diag; | |
32 | } | |
33 | ||
34 | use constant PI => 4 * atan2 1, 1; | |
35 | ||
10a0e555 HS |
36 | ok defined PI, 'basic scalar constant'; |
37 | is substr(PI, 0, 7), '3.14159', ' in substr()'; | |
54310121 | 38 | |
39 | sub deg2rad { PI * $_[0] / 180 } | |
40 | ||
41 | my $ninety = deg2rad 90; | |
42 | ||
10a0e555 | 43 | cmp_ok abs($ninety - 1.5707), '<', 0.0001, ' in math expression'; |
54310121 | 44 | |
45 | use constant UNDEF1 => undef; # the right way | |
46 | use constant UNDEF2 => ; # the weird way | |
47 | use constant 'UNDEF3' ; # the 'short' way | |
48 | use constant EMPTY => ( ) ; # the right way for lists | |
49 | ||
10a0e555 HS |
50 | is UNDEF1, undef, 'right way to declare an undef'; |
51 | is UNDEF2, undef, ' weird way'; | |
52 | is UNDEF3, undef, ' short way'; | |
53 | ||
54 | # XXX Why is this way different than the other ones? | |
54310121 | 55 | my @undef = UNDEF1; |
10a0e555 HS |
56 | is @undef, 1; |
57 | is $undef[0], undef; | |
58 | ||
54310121 | 59 | @undef = UNDEF2; |
10a0e555 | 60 | is @undef, 0; |
54310121 | 61 | @undef = UNDEF3; |
10a0e555 | 62 | is @undef, 0; |
54310121 | 63 | @undef = EMPTY; |
10a0e555 | 64 | is @undef, 0; |
54310121 | 65 | |
66 | use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5; | |
67 | use constant COUNTLIST => reverse 1, 2, 3, 4, 5; | |
68 | use constant COUNTLAST => (COUNTLIST)[-1]; | |
69 | ||
10a0e555 | 70 | is COUNTDOWN, '54321'; |
54310121 | 71 | my @cl = COUNTLIST; |
10a0e555 HS |
72 | is @cl, 5; |
73 | is COUNTDOWN, join '', @cl; | |
74 | is COUNTLAST, 1; | |
75 | is((COUNTLIST)[1], 4); | |
54310121 | 76 | |
77 | use constant ABC => 'ABC'; | |
10a0e555 | 78 | is "abc${\( ABC )}abc", "abcABCabc"; |
54310121 | 79 | |
9d116dd7 | 80 | use constant DEF => 'D', 'E', chr ord 'F'; |
10a0e555 | 81 | is "d e f @{[ DEF ]} d e f", "d e f D E F d e f"; |
54310121 | 82 | |
83 | use constant SINGLE => "'"; | |
84 | use constant DOUBLE => '"'; | |
85 | use constant BACK => '\\'; | |
86 | my $tt = BACK . SINGLE . DOUBLE ; | |
10a0e555 | 87 | is $tt, q(\\'"); |
54310121 | 88 | |
89 | use constant MESS => q('"'\\"'"\\); | |
10a0e555 HS |
90 | is MESS, q('"'\\"'"\\); |
91 | is length(MESS), 8; | |
54310121 | 92 | |
93 | use constant TRAILING => '12 cats'; | |
94 | { | |
d3a7d8c7 | 95 | no warnings 'numeric'; |
10a0e555 | 96 | cmp_ok TRAILING, '==', 12; |
54310121 | 97 | } |
10a0e555 | 98 | is TRAILING, '12 cats'; |
54310121 | 99 | |
c1b0f331 | 100 | use constant LEADING => " \t1234"; |
10a0e555 HS |
101 | cmp_ok LEADING, '==', 1234; |
102 | is LEADING, " \t1234"; | |
54310121 | 103 | |
104 | use constant ZERO1 => 0; | |
105 | use constant ZERO2 => 0.0; | |
106 | use constant ZERO3 => '0.0'; | |
10a0e555 HS |
107 | is ZERO1, '0'; |
108 | is ZERO2, '0'; | |
109 | is ZERO3, '0.0'; | |
54310121 | 110 | |
111 | { | |
112 | package Other; | |
113 | use constant PI => 3.141; | |
114 | } | |
115 | ||
10a0e555 HS |
116 | cmp_ok(abs(PI - 3.1416), '<', 0.0001); |
117 | is Other::PI, 3.141; | |
54310121 | 118 | |
119 | use constant E2BIG => $! = 7; | |
10a0e555 | 120 | cmp_ok E2BIG, '==', 7; |
54310121 | 121 | # This is something like "Arg list too long", but the actual message |
122 | # text may vary, so we can't test much better than this. | |
10a0e555 | 123 | cmp_ok length(E2BIG), '>', 6; |
54310121 | 124 | |
10a0e555 | 125 | is @warnings, 0 or diag join "\n", "unexpected warning", @warnings; |
54310121 | 126 | @warnings = (); # just in case |
127 | undef &PI; | |
10a0e555 HS |
128 | ok @warnings && ($warnings[0] =~ /Constant sub.* undefined/) or |
129 | diag join "\n", "unexpected warning", @warnings; | |
130 | shift @warnings; | |
54310121 | 131 | |
10a0e555 | 132 | is @warnings, 0, "unexpected warning"; |
779c5bc9 | 133 | |
10a0e555 HS |
134 | my $curr_test = $TB->current_test; |
135 | use constant CSCALAR => \"ok 37\n"; | |
136 | use constant CHASH => { foo => "ok 38\n" }; | |
137 | use constant CARRAY => [ undef, "ok 39\n" ]; | |
779c5bc9 GS |
138 | use constant CCODE => sub { "ok $_[0]\n" }; |
139 | ||
140 | print ${+CSCALAR}; | |
141 | print CHASH->{foo}; | |
142 | print CARRAY->[1]; | |
10a0e555 HS |
143 | print CCODE->($curr_test+4); |
144 | ||
145 | $TB->current_test($curr_test+4); | |
146 | ||
779c5bc9 | 147 | eval q{ CCODE->{foo} }; |
10a0e555 HS |
148 | ok scalar($@ =~ /^Constant is not a HASH/); |
149 | ||
83763826 GS |
150 | |
151 | # Allow leading underscore | |
152 | use constant _PRIVATE => 47; | |
10a0e555 | 153 | is _PRIVATE, 47; |
83763826 GS |
154 | |
155 | # Disallow doubled leading underscore | |
156 | eval q{ | |
157 | use constant __DISALLOWED => "Oops"; | |
158 | }; | |
10a0e555 | 159 | like $@, qr/begins with '__'/; |
83763826 GS |
160 | |
161 | # Check on declared() and %declared. This sub should be EXACTLY the | |
162 | # same as the one quoted in the docs! | |
163 | sub declared ($) { | |
164 | use constant 1.01; # don't omit this! | |
165 | my $name = shift; | |
166 | $name =~ s/^::/main::/; | |
167 | my $pkg = caller; | |
168 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; | |
169 | $constant::declared{$full_name}; | |
170 | } | |
171 | ||
10a0e555 HS |
172 | ok declared 'PI'; |
173 | ok $constant::declared{'main::PI'}; | |
83763826 | 174 | |
10a0e555 HS |
175 | ok !declared 'PIE'; |
176 | ok !$constant::declared{'main::PIE'}; | |
83763826 GS |
177 | |
178 | { | |
179 | package Other; | |
180 | use constant IN_OTHER_PACK => 42; | |
10a0e555 HS |
181 | ::ok ::declared 'IN_OTHER_PACK'; |
182 | ::ok $constant::declared{'Other::IN_OTHER_PACK'}; | |
183 | ::ok ::declared 'main::PI'; | |
184 | ::ok $constant::declared{'main::PI'}; | |
83763826 GS |
185 | } |
186 | ||
10a0e555 HS |
187 | ok declared 'Other::IN_OTHER_PACK'; |
188 | ok $constant::declared{'Other::IN_OTHER_PACK'}; | |
d3a7d8c7 GS |
189 | |
190 | @warnings = (); | |
191 | eval q{ | |
9f1b1f2d | 192 | no warnings; |
d3a7d8c7 GS |
193 | use warnings 'constant'; |
194 | use constant 'BEGIN' => 1 ; | |
195 | use constant 'INIT' => 1 ; | |
196 | use constant 'CHECK' => 1 ; | |
197 | use constant 'END' => 1 ; | |
198 | use constant 'DESTROY' => 1 ; | |
199 | use constant 'AUTOLOAD' => 1 ; | |
200 | use constant 'STDIN' => 1 ; | |
201 | use constant 'STDOUT' => 1 ; | |
202 | use constant 'STDERR' => 1 ; | |
203 | use constant 'ARGV' => 1 ; | |
204 | use constant 'ARGVOUT' => 1 ; | |
205 | use constant 'ENV' => 1 ; | |
206 | use constant 'INC' => 1 ; | |
207 | use constant 'SIG' => 1 ; | |
d3a7d8c7 GS |
208 | }; |
209 | ||
10a0e555 HS |
210 | is @warnings, 15 ; |
211 | my @Expected_Warnings = | |
212 | ( | |
213 | qr/^Constant name 'BEGIN' is a Perl keyword at/, | |
214 | qr/^Constant subroutine BEGIN redefined at/, | |
215 | qr/^Constant name 'INIT' is a Perl keyword at/, | |
216 | qr/^Constant name 'CHECK' is a Perl keyword at/, | |
217 | qr/^Constant name 'END' is a Perl keyword at/, | |
218 | qr/^Constant name 'DESTROY' is a Perl keyword at/, | |
219 | qr/^Constant name 'AUTOLOAD' is a Perl keyword at/, | |
220 | qr/^Constant name 'STDIN' is forced into package main:: a/, | |
221 | qr/^Constant name 'STDOUT' is forced into package main:: at/, | |
222 | qr/^Constant name 'STDERR' is forced into package main:: at/, | |
223 | qr/^Constant name 'ARGV' is forced into package main:: at/, | |
224 | qr/^Constant name 'ARGVOUT' is forced into package main:: at/, | |
225 | qr/^Constant name 'ENV' is forced into package main:: at/, | |
226 | qr/^Constant name 'INC' is forced into package main:: at/, | |
227 | qr/^Constant name 'SIG' is forced into package main:: at/, | |
228 | ); | |
229 | for my $idx (0..$#warnings) { | |
230 | like $warnings[$idx], $Expected_Warnings[$idx]; | |
231 | } | |
d3a7d8c7 | 232 | @warnings = (); |
c7206c54 CT |
233 | |
234 | ||
235 | use constant { | |
236 | THREE => 3, | |
237 | FAMILY => [ qw( John Jane Sally ) ], | |
238 | AGES => { John => 33, Jane => 28, Sally => 3 }, | |
239 | RFAM => [ [ qw( John Jane Sally ) ] ], | |
240 | SPIT => sub { shift }, | |
c7206c54 CT |
241 | }; |
242 | ||
10a0e555 HS |
243 | is @{+FAMILY}, THREE; |
244 | is @{+FAMILY}, @{RFAM->[0]}; | |
245 | is FAMILY->[2], RFAM->[0]->[2]; | |
246 | is AGES->{FAMILY->[1]}, 28; | |
247 | is THREE**3, SPIT->(@{+FAMILY}**3); |