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