I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / constant.t
CommitLineData
54310121 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
54310121 6}
7
9f1b1f2d 8use warnings;
54310121 9use vars qw{ @warnings };
10BEGIN { # ...and save 'em for later
11 $SIG{'__WARN__'} = sub { push @warnings, @_ }
12}
13END { print @warnings }
14
15######################### We start with some black magic to print on failure.
16
c7206c54 17BEGIN { $| = 1; print "1..82\n"; }
54310121 18END {print "not ok 1\n" unless $loaded;}
83763826 19use constant 1.01;
54310121 20$loaded = 1;
21#print "# Version: $constant::VERSION\n";
22print "ok 1\n";
23
24######################### End of black magic.
25
26use strict;
27
28sub 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
40use constant PI => 4 * atan2 1, 1;
41
42test 2, substr(PI, 0, 7) eq '3.14159';
43test 3, defined PI;
44
45sub deg2rad { PI * $_[0] / 180 }
46
47my $ninety = deg2rad 90;
48
49test 4, $ninety > 1.5707;
50test 5, $ninety < 1.5708;
51
52use constant UNDEF1 => undef; # the right way
53use constant UNDEF2 => ; # the weird way
54use constant 'UNDEF3' ; # the 'short' way
55use constant EMPTY => ( ) ; # the right way for lists
56
57test 6, not defined UNDEF1;
58test 7, not defined UNDEF2;
59test 8, not defined UNDEF3;
60my @undef = UNDEF1;
61test 9, @undef == 1;
62test 10, not defined $undef[0];
63@undef = UNDEF2;
64test 11, @undef == 0;
65@undef = UNDEF3;
66test 12, @undef == 0;
67@undef = EMPTY;
68test 13, @undef == 0;
69
70use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
71use constant COUNTLIST => reverse 1, 2, 3, 4, 5;
72use constant COUNTLAST => (COUNTLIST)[-1];
73
74test 14, COUNTDOWN eq '54321';
75my @cl = COUNTLIST;
76test 15, @cl == 5;
77test 16, COUNTDOWN eq join '', @cl;
78test 17, COUNTLAST == 1;
79test 18, (COUNTLIST)[1] == 4;
80
81use constant ABC => 'ABC';
82test 19, "abc${\( ABC )}abc" eq "abcABCabc";
83
9d116dd7 84use constant DEF => 'D', 'E', chr ord 'F';
54310121 85test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
86
87use constant SINGLE => "'";
88use constant DOUBLE => '"';
89use constant BACK => '\\';
90my $tt = BACK . SINGLE . DOUBLE ;
91test 21, $tt eq q(\\'");
92
93use constant MESS => q('"'\\"'"\\);
94test 22, MESS eq q('"'\\"'"\\);
95test 23, length(MESS) == 8;
96
97use constant TRAILING => '12 cats';
98{
d3a7d8c7 99 no warnings 'numeric';
54310121 100 test 24, TRAILING == 12;
54310121 101}
102test 25, TRAILING eq '12 cats';
103
c1b0f331 104use constant LEADING => " \t1234";
54310121 105test 26, LEADING == 1234;
c1b0f331 106test 27, LEADING eq " \t1234";
54310121 107
108use constant ZERO1 => 0;
109use constant ZERO2 => 0.0;
110use constant ZERO3 => '0.0';
111test 28, ZERO1 eq '0';
112test 29, ZERO2 eq '0';
113test 30, ZERO3 eq '0.0';
114
115{
116 package Other;
117 use constant PI => 3.141;
118}
119
120test 31, (PI > 3.1415 and PI < 3.1416);
121test 32, Other::PI == 3.141;
122
123use constant E2BIG => $! = 7;
124test 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.
127test 34, length(E2BIG) > 6;
128test 35, index(E2BIG, " ") > 0;
129
130test 36, @warnings == 0, join "\n", "unexpected warning", @warnings;
131@warnings = (); # just in case
132undef &PI;
133test 37, @warnings &&
134 ($warnings[0] =~ /Constant sub.* undefined/),
135 shift @warnings;
136
137test 38, @warnings == 0, "unexpected warning";
9f1b1f2d 138test 39, 1;
779c5bc9 139
140use constant CSCALAR => \"ok 40\n";
141use constant CHASH => { foo => "ok 41\n" };
142use constant CARRAY => [ undef, "ok 42\n" ];
143use constant CPHASH => [ { foo => 1 }, "ok 43\n" ];
144use constant CCODE => sub { "ok $_[0]\n" };
145
146print ${+CSCALAR};
147print CHASH->{foo};
148print CARRAY->[1];
149print CPHASH->{foo};
150eval q{ CPHASH->{bar} };
ae9a5a84 151test 44, scalar($@ =~ /^No such pseudo-hash field/);
779c5bc9 152print CCODE->(45);
153eval q{ CCODE->{foo} };
154test 46, scalar($@ =~ /^Constant is not a HASH/);
83763826 155
156# Allow leading underscore
157use constant _PRIVATE => 47;
158test 47, _PRIVATE == 47;
159
160# Disallow doubled leading underscore
161eval q{
162 use constant __DISALLOWED => "Oops";
163};
164test 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!
168sub 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
177test 49, declared 'PI';
178test 50, $constant::declared{'main::PI'};
179
180test 51, !declared 'PIE';
181test 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
192test 57, declared 'Other::IN_OTHER_PACK';
193test 58, $constant::declared{'Other::IN_OTHER_PACK'};
d3a7d8c7 194
195@warnings = ();
196eval q{
9f1b1f2d 197 no warnings;
d3a7d8c7 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 213};
214
036b4402 215test 59, @warnings == 15 ;
d3a7d8c7 216test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
036b4402 217shift @warnings; #Constant subroutine BEGIN redefined at
d3a7d8c7 218test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
219test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
220test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
221test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
222test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
223test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
224test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
225test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
226test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
227test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
228test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
229test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
230test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
231@warnings = ();
c7206c54 232
233
234use 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
243test 74, @{+FAMILY} == THREE;
244test 75, @{+FAMILY} == @{RFAM->[0]};
245test 76, FAMILY->[2] eq RFAM->[0]->[2];
246test 77, AGES->{FAMILY->[1]} == 28;
247test 78, PHFAM->{John} == AGES->{John};
248test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
249test 80, @{+PHFAM} == SPIT->(THREE+1);
250test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
251test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];