Commit | Line | Data |
54310121 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
93430cb4 |
5 | unshift @INC, '../lib' if -d '../lib'; |
54310121 |
6 | } |
7 | |
8 | BEGIN {$^W |= 1} # Insist upon 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 | |
83763826 |
17 | BEGIN { $| = 1; print "1..58\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 | { |
99 | my $save_warn; |
100 | local $^W; |
101 | BEGIN { $save_warn = $^W; $^W = 0 } |
102 | test 24, TRAILING == 12; |
103 | BEGIN { $^W = $save_warn } |
104 | } |
105 | test 25, TRAILING eq '12 cats'; |
106 | |
c1b0f331 |
107 | use constant LEADING => " \t1234"; |
54310121 |
108 | test 26, LEADING == 1234; |
c1b0f331 |
109 | test 27, LEADING eq " \t1234"; |
54310121 |
110 | |
111 | use constant ZERO1 => 0; |
112 | use constant ZERO2 => 0.0; |
113 | use constant ZERO3 => '0.0'; |
114 | test 28, ZERO1 eq '0'; |
115 | test 29, ZERO2 eq '0'; |
116 | test 30, ZERO3 eq '0.0'; |
117 | |
118 | { |
119 | package Other; |
120 | use constant PI => 3.141; |
121 | } |
122 | |
123 | test 31, (PI > 3.1415 and PI < 3.1416); |
124 | test 32, Other::PI == 3.141; |
125 | |
126 | use constant E2BIG => $! = 7; |
127 | test 33, E2BIG == 7; |
128 | # This is something like "Arg list too long", but the actual message |
129 | # text may vary, so we can't test much better than this. |
130 | test 34, length(E2BIG) > 6; |
131 | test 35, index(E2BIG, " ") > 0; |
132 | |
133 | test 36, @warnings == 0, join "\n", "unexpected warning", @warnings; |
134 | @warnings = (); # just in case |
135 | undef &PI; |
136 | test 37, @warnings && |
137 | ($warnings[0] =~ /Constant sub.* undefined/), |
138 | shift @warnings; |
139 | |
140 | test 38, @warnings == 0, "unexpected warning"; |
141 | test 39, $^W & 1, "Who disabled the warnings?"; |
779c5bc9 |
142 | |
143 | use constant CSCALAR => \"ok 40\n"; |
144 | use constant CHASH => { foo => "ok 41\n" }; |
145 | use constant CARRAY => [ undef, "ok 42\n" ]; |
146 | use constant CPHASH => [ { foo => 1 }, "ok 43\n" ]; |
147 | use constant CCODE => sub { "ok $_[0]\n" }; |
148 | |
149 | print ${+CSCALAR}; |
150 | print CHASH->{foo}; |
151 | print CARRAY->[1]; |
152 | print CPHASH->{foo}; |
153 | eval q{ CPHASH->{bar} }; |
ae9a5a84 |
154 | test 44, scalar($@ =~ /^No such pseudo-hash field/); |
779c5bc9 |
155 | print CCODE->(45); |
156 | eval q{ CCODE->{foo} }; |
157 | test 46, scalar($@ =~ /^Constant is not a HASH/); |
83763826 |
158 | |
159 | # Allow leading underscore |
160 | use constant _PRIVATE => 47; |
161 | test 47, _PRIVATE == 47; |
162 | |
163 | # Disallow doubled leading underscore |
164 | eval q{ |
165 | use constant __DISALLOWED => "Oops"; |
166 | }; |
167 | test 48, $@ =~ /begins with '__'/; |
168 | |
169 | # Check on declared() and %declared. This sub should be EXACTLY the |
170 | # same as the one quoted in the docs! |
171 | sub declared ($) { |
172 | use constant 1.01; # don't omit this! |
173 | my $name = shift; |
174 | $name =~ s/^::/main::/; |
175 | my $pkg = caller; |
176 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; |
177 | $constant::declared{$full_name}; |
178 | } |
179 | |
180 | test 49, declared 'PI'; |
181 | test 50, $constant::declared{'main::PI'}; |
182 | |
183 | test 51, !declared 'PIE'; |
184 | test 52, !$constant::declared{'main::PIE'}; |
185 | |
186 | { |
187 | package Other; |
188 | use constant IN_OTHER_PACK => 42; |
189 | ::test 53, ::declared 'IN_OTHER_PACK'; |
190 | ::test 54, $constant::declared{'Other::IN_OTHER_PACK'}; |
191 | ::test 55, ::declared 'main::PI'; |
192 | ::test 56, $constant::declared{'main::PI'}; |
193 | } |
194 | |
195 | test 57, declared 'Other::IN_OTHER_PACK'; |
196 | test 58, $constant::declared{'Other::IN_OTHER_PACK'}; |