constant.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
BEGIN {
chdir 't' if -d 't';
}
use warnings;
}
######################### We start with some black magic to print on failure.
use constant 1.01;
$loaded = 1;
#print "# Version: $constant::VERSION\n";
print "ok 1\n";
######################### End of black magic.
use strict;
sub test ($$;$) {
return;
}
$diag =~ s/\Z\n?/\n/; # unchomp
}
test 4, $ninety > 1.5707;
test 5, $ninety < 1.5708;
test 9, @undef == 1;
test 11, @undef == 0;
test 12, @undef == 0;
test 13, @undef == 0;
test 15, @cl == 5;
test 17, COUNTLAST == 1;
my $tt = BACK . SINGLE . DOUBLE ;
test 21, $tt eq q(\\'");
use constant MESS => q('"'\\"'"\\);
test 22, MESS eq q('"'\\"'"\\);
test 23, length(MESS) == 8;
{
test 24, TRAILING == 12;
}
use constant LEADING => " \t1234";
test 26, LEADING == 1234;
test 27, LEADING eq " \t1234";
use constant ZERO1 => 0;
use constant ZERO2 => 0.0;
use constant ZERO3 => '0.0';
test 28, ZERO1 eq '0';
test 29, ZERO2 eq '0';
test 30, ZERO3 eq '0.0';
{
package Other;
use constant PI => 3.141;
}
test 31, (PI > 3.1415 and PI < 3.1416);
test 32, Other::PI == 3.141;
use constant E2BIG => $! = 7;
test 33, E2BIG == 7;
# This is something like "Arg list too long", but the actual message
test 35, 1; # Skipped: used to assume " ", false in ja_JP.eucJP on Linux
test 37, @warnings &&
shift @warnings;
test 39, 1;
print ${+CSCALAR};
print CHASH->{foo};
print CARRAY->[1];
print CPHASH->{foo};
eval q{ CPHASH->{bar} };
test 44, scalar($@ =~ /^No such pseudo-hash field/);
print CCODE->(45);
eval q{ CCODE->{foo} };
test 46, scalar($@ =~ /^Constant is not a HASH/);
# Allow leading underscore
use constant _PRIVATE => 47;
test 47, _PRIVATE == 47;
# Disallow doubled leading underscore
eval q{
};
test 48, $@ =~ /begins with '__'/;
# Check on declared() and %declared. This sub should be EXACTLY the
# same as the one quoted in the docs!
sub declared ($) {
use constant 1.01; # don't omit this!
my $name = shift;
$name =~ s/^::/main::/;
my $pkg = caller;
$constant::declared{$full_name};
}
test 49, declared 'PI';
test 50, $constant::declared{'main::PI'};
test 51, !declared 'PIE';
test 52, !$constant::declared{'main::PIE'};
{
package Other;
use constant IN_OTHER_PACK => 42;
::test 53, ::declared 'IN_OTHER_PACK';
::test 54, $constant::declared{'Other::IN_OTHER_PACK'};
::test 55, ::declared 'main::PI';
::test 56, $constant::declared{'main::PI'};
}
test 57, declared 'Other::IN_OTHER_PACK';
test 58, $constant::declared{'Other::IN_OTHER_PACK'};
@warnings = ();
eval q{
no warnings;
use warnings 'constant';
use constant 'BEGIN' => 1 ;
use constant 'INIT' => 1 ;
use constant 'CHECK' => 1 ;
use constant 'END' => 1 ;
use constant 'DESTROY' => 1 ;
use constant 'AUTOLOAD' => 1 ;
use constant 'STDIN' => 1 ;
use constant 'STDOUT' => 1 ;
use constant 'STDERR' => 1 ;
use constant 'ARGV' => 1 ;
use constant 'ARGVOUT' => 1 ;
use constant 'ENV' => 1 ;
use constant 'INC' => 1 ;
use constant 'SIG' => 1 ;
};
test 59, @warnings == 15 ;
test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
shift @warnings; #Constant subroutine BEGIN redefined at
test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
@warnings = ();
use constant {
THREE => 3,
FAMILY => [ qw( John Jane Sally ) ],
AGES => { John => 33, Jane => 28, Sally => 3 },
RFAM => [ [ qw( John Jane Sally ) ] ],
SPIT => sub { shift },
PHFAM => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
};
test 74, @{+FAMILY} == THREE;
test 75, @{+FAMILY} == @{RFAM->[0]};
test 76, FAMILY->[2] eq RFAM->[0]->[2];
test 77, AGES->{FAMILY->[1]} == 28;
{ no warnings 'deprecated'; test 78, PHFAM->{John} == AGES->{John}; }
test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
test 80, @{+PHFAM} == SPIT->(THREE+1);
test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];