This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
RC3: lib/constant.t #35
[perl5.git] / lib / constant.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 use warnings;
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
17 BEGIN { $| = 1; print "1..82\n"; }
18 END {print "not ok 1\n" unless $loaded;}
19 use constant 1.01;
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
84 use constant DEF        => 'D', 'E', chr ord 'F';
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 {
99     no warnings 'numeric';
100     test 24, TRAILING == 12;
101 }
102 test 25, TRAILING eq '12 cats';
103
104 use constant LEADING    => " \t1234";
105 test 26, LEADING == 1234;
106 test 27, LEADING eq " \t1234";
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, 1; # Skipped: used to assume " ", false in ja_JP.eucJP on Linux
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";
138 test 39, 1;
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} };
151 test 44, scalar($@ =~ /^No such pseudo-hash field/);
152 print CCODE->(45);
153 eval q{ CCODE->{foo} };
154 test 46, scalar($@ =~ /^Constant is not a HASH/);
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'};
194
195 @warnings = ();
196 eval q{
197     no warnings;
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 ;
213 };
214
215 test 59, @warnings == 15 ;
216 test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
217 shift @warnings; #Constant subroutine BEGIN redefined at
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 = ();
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];