view release on metacpan or  search on metacpan

t/Variables/RequireLocalizedPunctuationVars.run.PL  view on Meta::CPAN

        print {$test_file} "($varname) = ();\n";
    }

    return;
}


sub print_fail_non_local_deref {
    my ($test_file, $globals) = @_;

    my %subscript = (
        '%' => '{foo}',
        '@' => '[0]',
    );

    my @derefs = grep { $subscript{substr $_, 0, 1} && !$exemptions{$_} }
        @{ $globals };
    my $numvars = scalar @derefs;

    print {$test_file} <<"END_CODE";

#-----------------------------------------------------------------------------

## name Named magic variables, fail non-local dereferenced
## failures $numvars
## cut

END_CODE

    foreach my $varname ( @derefs ) {
        my ($sigil, $barename) = $varname =~ m/ (.)(.*) /smx;
        print {$test_file} '$', $barename,
            $subscript{$sigil}, " = 'bar';\n";
    }

}


sub print_footer {
    my ($test_file) = @_;

    print {$test_file} <<'END_CODE';

#-----------------------------------------------------------------------------

## name Allowing a variable with a particular sigil doesn't allow other variables with the same name but different sigils
## failures 1
## parms { allow => '$ARGV' }
## cut

@ARGV = (1, 2, 3);

#-----------------------------------------------------------------------------

## name Allow "my" as well, RT #33937
## failures 0
## cut

for my $entry (
   sort {
       my @a = split m{,}xms, $a;
       my @b = split m{,}xms, $b;
       $a[0] cmp $b[0] || $a[1] <=> $b[1]
   } qw( b,6 c,3 )
   )
{
   print;
}

#-----------------------------------------------------------------------------
# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
END_CODE

    return;
}

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :