view release on metacpan or  search on metacpan

t/constant.t  view on Meta::CPAN

# Disallow doubled leading underscore
eval q{
    use constant __DISALLOWED => "Oops";
};
like $@, qr/Invalid name '__DISALLOWED'/;

SKIP: {
skip ": %declared is not supported", 10;
# 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;
    my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
    $constant::declared{$full_name};
}

ok declared 'PI';
ok $constant::declared{'main::PI'};

ok !declared 'PIE';
ok !$constant::declared{'main::PIE'};

{
    package Other;
    use constant IN_OTHER_PACK => 42;
    ::ok ::declared 'IN_OTHER_PACK';
    ::ok $constant::declared{'Other::IN_OTHER_PACK'};
    ::ok ::declared 'main::PI';
    ::ok $constant::declared{'main::PI'};
}

ok declared 'Other::IN_OTHER_PACK';
ok $constant::declared{'Other::IN_OTHER_PACK'};
}

SKIP: {
skip ": warnings are not supported", 18;

@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 ;
    use constant 'UNITCHECK' => 1;
};

my @Expected_Warnings = 
  (
   qr/^Constant name 'BEGIN' is a Perl keyword at/,
   qr/^Constant subroutine BEGIN redefined at/,
   qr/^Constant name 'INIT' is a Perl keyword at/,
   qr/^Constant name 'CHECK' is a Perl keyword at/,
   qr/^Constant name 'END' is a Perl keyword at/,
   qr/^Constant name 'DESTROY' is a Perl keyword at/,
   qr/^Constant name 'AUTOLOAD' is a Perl keyword at/,
   qr/^Constant name 'STDIN' is forced into package main:: a/,
   qr/^Constant name 'STDOUT' is forced into package main:: at/,
   qr/^Constant name 'STDERR' is forced into package main:: at/,
   qr/^Constant name 'ARGV' is forced into package main:: at/,
   qr/^Constant name 'ARGVOUT' is forced into package main:: at/,
   qr/^Constant name 'ENV' is forced into package main:: at/,
   qr/^Constant name 'INC' is forced into package main:: at/,
   qr/^Constant name 'SIG' is forced into package main:: at/,
   qr/^Constant name 'UNITCHECK' is a Perl keyword at/,
);

unless ($] > 5.009) {
    # Remove the UNITCHECK warning
    pop @Expected_Warnings;
    # But keep the count the same
    push @Expected_Warnings, qr/^$/;
    push @warnings, "";
}

# when run under "make test"
if (@warnings == 16) {
    push @warnings, "";
    push @Expected_Warnings, qr/^$/;
}
# when run directly: perl -wT -Ilib t/constant.t
elsif (@warnings == 17) {
    splice @Expected_Warnings, 1, 0, 
        qr/^Prototype mismatch: sub main::BEGIN \(\) vs none at/;
}
# when run directly under 5.6.2: perl -wT -Ilib t/constant.t
elsif (@warnings == 15) {
    splice @Expected_Warnings, 1, 1;
    push @warnings, "", "";
    push @Expected_Warnings, qr/^$/, qr/^$/;
}
else {
    my $rule = " -" x 20;
    diag "/!\\ unexpected case: ", scalar @warnings, " warnings\n$rule\n";
    diag map { "  $_" } @warnings;
    diag $rule, $/;
}

is @warnings, 17;

for my $idx (0..$#warnings) {
    like $warnings[$idx], $Expected_Warnings[$idx];
}
} # SKIP

@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 },
};

is @{+FAMILY}, THREE;
is @{+FAMILY}, @{RFAM->[0]};
is FAMILY->[2], RFAM->[0]->[2];
is AGES->{FAMILY->[1]}, 28;
is THREE**3, SPIT->(@{+FAMILY}**3);

# Allow name of digits/underscores only if it begins with underscore
TODO: {
    local $TODO = "allow tolerable names";
    # constant::tiny does not register a warnings category
    #use warnings FATAL => 'constant';
    eval q{
        use constant _1_2_3 => 'allowed';