This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #32400] Unnecessary warning from constant.pm
[perl5.git] / lib / constant.t
CommitLineData
54310121
PP
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
54310121
PP
6}
7
9f1b1f2d 8use warnings;
54310121
PP
9use vars qw{ @warnings };
10BEGIN { # ...and save 'em for later
11 $SIG{'__WARN__'} = sub { push @warnings, @_ }
12}
803b07a7 13END { print STDERR @warnings }
54310121 14
54310121
PP
15
16use strict;
5b673cda 17use Test::More tests => 75;
10a0e555
HS
18my $TB = Test::More->builder;
19
20BEGIN { use_ok('constant'); }
54310121
PP
21
22sub 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
34use constant PI => 4 * atan2 1, 1;
35
10a0e555
HS
36ok defined PI, 'basic scalar constant';
37is substr(PI, 0, 7), '3.14159', ' in substr()';
54310121
PP
38
39sub deg2rad { PI * $_[0] / 180 }
40
41my $ninety = deg2rad 90;
42
10a0e555 43cmp_ok abs($ninety - 1.5707), '<', 0.0001, ' in math expression';
54310121
PP
44
45use constant UNDEF1 => undef; # the right way
46use constant UNDEF2 => ; # the weird way
47use constant 'UNDEF3' ; # the 'short' way
48use constant EMPTY => ( ) ; # the right way for lists
49
10a0e555
HS
50is UNDEF1, undef, 'right way to declare an undef';
51is UNDEF2, undef, ' weird way';
52is UNDEF3, undef, ' short way';
53
54# XXX Why is this way different than the other ones?
54310121 55my @undef = UNDEF1;
10a0e555
HS
56is @undef, 1;
57is $undef[0], undef;
58
54310121 59@undef = UNDEF2;
10a0e555 60is @undef, 0;
54310121 61@undef = UNDEF3;
10a0e555 62is @undef, 0;
54310121 63@undef = EMPTY;
10a0e555 64is @undef, 0;
54310121
PP
65
66use constant COUNTDOWN => scalar reverse 1, 2, 3, 4, 5;
67use constant COUNTLIST => reverse 1, 2, 3, 4, 5;
68use constant COUNTLAST => (COUNTLIST)[-1];
69
10a0e555 70is COUNTDOWN, '54321';
54310121 71my @cl = COUNTLIST;
10a0e555
HS
72is @cl, 5;
73is COUNTDOWN, join '', @cl;
74is COUNTLAST, 1;
75is((COUNTLIST)[1], 4);
54310121
PP
76
77use constant ABC => 'ABC';
10a0e555 78is "abc${\( ABC )}abc", "abcABCabc";
54310121 79
9d116dd7 80use constant DEF => 'D', 'E', chr ord 'F';
10a0e555 81is "d e f @{[ DEF ]} d e f", "d e f D E F d e f";
54310121
PP
82
83use constant SINGLE => "'";
84use constant DOUBLE => '"';
85use constant BACK => '\\';
86my $tt = BACK . SINGLE . DOUBLE ;
10a0e555 87is $tt, q(\\'");
54310121
PP
88
89use constant MESS => q('"'\\"'"\\);
10a0e555
HS
90is MESS, q('"'\\"'"\\);
91is length(MESS), 8;
54310121
PP
92
93use constant TRAILING => '12 cats';
94{
d3a7d8c7 95 no warnings 'numeric';
10a0e555 96 cmp_ok TRAILING, '==', 12;
54310121 97}
10a0e555 98is TRAILING, '12 cats';
54310121 99
c1b0f331 100use constant LEADING => " \t1234";
10a0e555
HS
101cmp_ok LEADING, '==', 1234;
102is LEADING, " \t1234";
54310121
PP
103
104use constant ZERO1 => 0;
105use constant ZERO2 => 0.0;
106use constant ZERO3 => '0.0';
10a0e555
HS
107is ZERO1, '0';
108is ZERO2, '0';
109is ZERO3, '0.0';
54310121
PP
110
111{
112 package Other;
113 use constant PI => 3.141;
114}
115
10a0e555
HS
116cmp_ok(abs(PI - 3.1416), '<', 0.0001);
117is Other::PI, 3.141;
54310121
PP
118
119use constant E2BIG => $! = 7;
10a0e555 120cmp_ok E2BIG, '==', 7;
54310121
PP
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 123cmp_ok length(E2BIG), '>', 6;
54310121 124
10a0e555 125is @warnings, 0 or diag join "\n", "unexpected warning", @warnings;
54310121
PP
126@warnings = (); # just in case
127undef &PI;
10a0e555
HS
128ok @warnings && ($warnings[0] =~ /Constant sub.* undefined/) or
129 diag join "\n", "unexpected warning", @warnings;
130shift @warnings;
54310121 131
10a0e555 132is @warnings, 0, "unexpected warning";
779c5bc9 133
10a0e555
HS
134my $curr_test = $TB->current_test;
135use constant CSCALAR => \"ok 37\n";
136use constant CHASH => { foo => "ok 38\n" };
137use constant CARRAY => [ undef, "ok 39\n" ];
779c5bc9
GS
138use constant CCODE => sub { "ok $_[0]\n" };
139
140print ${+CSCALAR};
141print CHASH->{foo};
142print CARRAY->[1];
10a0e555
HS
143print CCODE->($curr_test+4);
144
145$TB->current_test($curr_test+4);
146
779c5bc9 147eval q{ CCODE->{foo} };
10a0e555
HS
148ok scalar($@ =~ /^Constant is not a HASH/);
149
83763826
GS
150
151# Allow leading underscore
152use constant _PRIVATE => 47;
10a0e555 153is _PRIVATE, 47;
83763826
GS
154
155# Disallow doubled leading underscore
156eval q{
157 use constant __DISALLOWED => "Oops";
158};
10a0e555 159like $@, 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!
163sub 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
172ok declared 'PI';
173ok $constant::declared{'main::PI'};
83763826 174
10a0e555
HS
175ok !declared 'PIE';
176ok !$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
187ok declared 'Other::IN_OTHER_PACK';
188ok $constant::declared{'Other::IN_OTHER_PACK'};
d3a7d8c7
GS
189
190@warnings = ();
191eval 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
210is @warnings, 15 ;
211my @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);
229for my $idx (0..$#warnings) {
230 like $warnings[$idx], $Expected_Warnings[$idx];
231}
d3a7d8c7 232@warnings = ();
c7206c54
CT
233
234
235use 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
243is @{+FAMILY}, THREE;
244is @{+FAMILY}, @{RFAM->[0]};
245is FAMILY->[2], RFAM->[0]->[2];
246is AGES->{FAMILY->[1]}, 28;
247is THREE**3, SPIT->(@{+FAMILY}**3);
5b673cda
AS
248
249# Allow name of digits/underscores only if it begins with underscore
250{
251 use warnings FATAL => 'constant';
252 eval q{
253 use constant _1_2_3 => 'allowed';
254 };
255 ok( $@ eq '' );
256}