The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use 5.006001;
use strict;
use warnings;

use English qw< -no_match_vars >;
use Carp qw< confess >;

use Carp qw< confess >;
use Fatal qw< open close >;

our $VERSION = '1.121';



my $this_program = __FILE__;
(my $test_file_name = $this_program) =~ s/ [.] PL \z //xms;
if ($this_program eq $test_file_name) {
    confess
        'Was not able to figure out the name of the file to generate.'
        . "This program: $this_program.";
}

print "\n\nGenerating $test_file_name.\n";



open my $test_file, '>', $test_file_name    ## no critic (RequireBriefOpen)
    or confess "Could not open $test_file_name: $ERRNO";


print {$test_file} <<"END_HEADER";
# Do not edit!!!  This test suite generated by $this_program.
END_HEADER

emit_simple_tests($test_file);
emit_primary_tests($test_file);
emit_footer($test_file);

close $test_file;
print "Done.\n\n";

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

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

    print {$test_file} <<'END_SIMPLE_TESTS';
#-----------------------------------------------------------------------------

## name Basic Passes
## failures 0
## cut

my  $foo;
our $bar;
my($foo, $bar) = ("BLEH", "BLEH");
my @foo;
my %bar;
sub foo {}

my  $foo123;
my  $foo123bar;
sub foo123 {}
sub foo123bar {}

package This::SomeThing;
package This;
package This::Thing;
package Acme::12345;
package YYZ;

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

## name Basic Failures
## failures 14
## cut

my  $Foo;
our $Bar;
my  @Foo;
my  %Bar;
sub Foo {}

my  $foo_Bar;
sub foo_Bar {}

my  $FooBar;
sub FooBar {}

my  $foo123Bar;
sub foo123Bar {}

package pragma;
package Foo::baz;
package baz::FooBar;

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

## name Special case: main
## failures 0
## cut

package main;

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

## name Combined passes and fails
## failures 2
## cut

my($foo, $Bar);
our($Bar, $foo);

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

## name Variables from other packages should pass
## failures 0
## cut

local $Other::Package::Foo;
$Other::Package::Foo;

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

## name Only cares about declarations
## failures 0
## cut
Foo();
$Foo = 42;

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

## name Constants must be all caps, passes
## failures 0
## cut

Readonly::Scalar my $CONSTANT = 23;
const my $CONSTANT = 23;
use constant FOO => 42;
use constant { BAR => 3, BAZ => 7 };
use constant 1.16 FOO => 42;
use constant 1.16 { BAR => 3, BAZ => 7 };

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

## name Constants must be all caps, failures
## failures 3
## cut

Readonly::Scalar my $Foo = 23;
Readonly::Scalar my $foo = 23;
const my $fooBAR = 23;

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

## name PPI misparses part of ternary as a label (RT #41170)
## failures 0
## cut

my $foo = $condition ? $objection->method : $alternative;
my $foo = $condition ? undef : 1;

END_SIMPLE_TESTS

    return;
}


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

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'guaranteed_to_pass', ':single_case', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'guaranteed_to_pass', ':single_case', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'mixedCase', 'guaranteed_to_pass', ':single_case', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'guaranteed_to_pass', ':single_case', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'guaranteed_to_pass', ':single_case', 0,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'guaranteed_to_pass', ':all_lower', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'guaranteed_to_pass', ':all_lower', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'mixedCase', 'guaranteed_to_pass', ':all_lower', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'guaranteed_to_pass', ':all_lower', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'guaranteed_to_pass', ':all_lower', 1,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'GUARANTEED_TO_PASS', ':all_upper', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'GUARANTEED_TO_PASS', ':all_upper', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'mixedCase', 'GUARANTEED_TO_PASS', ':all_upper', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'GUARANTEED_TO_PASS', ':all_upper', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'GUARANTEED_TO_PASS', ':all_upper', 0,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'guaranteed_to_pass', ':starts_with_lower', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'guaranteed_to_pass', ':starts_with_lower', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file,
        '________all_lower_case_with_leading_underscores',
        'guaranteed_to_pass',
        ':starts_with_lower',
        0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'guaranteed_to_pass', ':starts_with_lower', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'guaranteed_to_pass', ':starts_with_lower', 1,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'GUARANTEED_TO_PASS', ':starts_with_upper', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'GUARANTEED_TO_PASS', ':starts_with_upper', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file,
        '________ALL_UPPER_CASE_WITH_LEADING_UNDERSCORES',
        'GUARANTEED_TO_PASS',
        ':starts_with_upper',
        0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'GUARANTEED_TO_PASS', ':starts_with_upper', 1,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'GUARANTEED_TO_PASS', ':starts_with_upper', 0,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'all_lower_case', 'guaranteed_to_pass', ':no_restriction', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'ALL_UPPER_CASE', 'guaranteed_to_pass', ':no_restriction', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'mixedCase', 'guaranteed_to_pass', ':no_restriction', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file,
        '________ALL_UPPER_CASE_WITH_LEADING_UNDERSCORES',
        'guaranteed_to_pass',
        ':no_restriction',
        0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'a11_lower_case_with_digits', 'guaranteed_to_pass', ':no_restriction', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'A11_UPPER_CASE_WITH_DIGITS', 'guaranteed_to_pass', ':no_restriction', 0,
    );

    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'foobar', 'foo_guaranteed_to_pass_bar', 'foo.*bar', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'fooXYZZYbar', 'foo_guaranteed_to_pass_bar', 'foo.*bar', 0,
    );
    emit_all_tests_for_name_and_capitalization_scheme(
        $test_file, 'xyzzy', 'foo_guaranteed_to_pass_bar', 'foo.*bar', 1,
    );

    return;
}


sub emit_all_tests_for_name_and_capitalization_scheme {
    my ($test_file, $name, $guaranteed_to_pass, $capitalization_scheme, $failures)
        = @_;

    emit_package_test(
        $test_file,
        $name,
        $guaranteed_to_pass,
        $capitalization_scheme,
        $failures
    );
    emit_subroutine_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_local_lexical_variable_in_subroutine_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_local_lexical_variable_in_scheduled_subroutine_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_scoped_lexical_variable_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_file_lexical_variable_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_global_variable_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_foreach_loop_variable_tests(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_c_style_for_loop_variable_tests(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_local_lexical_variable_in_io_assignment_in_while_loop_test(
        $test_file, $name, $capitalization_scheme, $failures,
    );
    emit_label_test($test_file, $name, $capitalization_scheme, $failures);

    return;
}


sub emit_package_test {
    my ($test_file, $package_name, $good_package_component, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_PACKAGE_TEST";

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

## name Package named "$package_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { packages => '$capitalization_scheme' }
## cut

package $package_name;

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

## name Exempted package named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { packages => '$capitalization_scheme', package_exemptions => 'bLa.*LaH' }
## cut

package bLaHlAhLaH;

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

## name Package named "${good_package_component}::$package_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { packages => '$capitalization_scheme' }
## cut

package ${good_package_component}::$package_name;
END_PACKAGE_TEST

    return;
}


sub emit_subroutine_test {
    my ($test_file, $subroutine_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_SUBROUTINE_TEST";

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

## name Subroutine named "$subroutine_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { subroutines => '$capitalization_scheme' }
## cut

sub $subroutine_name {
    # Blah blah blah
}

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

## name Exempted subroutine named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { subroutines => '$capitalization_scheme', subroutine_exemptions => 'bLa.*LaH' }
## cut

sub bLaHlAhLaH {
    # Blah blah blah
}

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

## name Subroutine named "Foo::Bar::$subroutine_name" vs the "$capitalization_scheme" capitalization scheme.
## parms { subroutines => '$capitalization_scheme' }
## failures $failures
## cut

sub Foo::Bar::$subroutine_name;

END_SUBROUTINE_TEST

    return;
}


sub emit_local_lexical_variable_in_subroutine_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_LOCAL_LEXICAL_VARIABLE_TEST";

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

## name Local lexical variable in subroutine named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { subroutines => ':all_lower', local_lexical_variables => '$capitalization_scheme' }
## cut

sub some_subroutine {
    my \$$variable_name;
}

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

## name Exempted local lexical variable in subroutine named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { subroutines => ':all_lower', local_lexical_variables => '$capitalization_scheme', local_lexical_variable_exemptions => 'bLa.*LaH' }
## cut

sub some_subroutine {
    my \$bLaHlAhLaH;
}
END_LOCAL_LEXICAL_VARIABLE_TEST

    return;
}


sub emit_local_lexical_variable_in_scheduled_subroutine_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_LOCAL_LEXICAL_VARIABLE_TEST";

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

## name Local lexical variable in subroutine named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

CHECK {
    my \$$variable_name;
}
END_LOCAL_LEXICAL_VARIABLE_TEST

    return;
}


sub emit_scoped_lexical_variable_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_SCOPED_LEXICAL_VARIABLE_TEST";

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

## name Scoped lexical variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { scoped_lexical_variables => '$capitalization_scheme' }
## cut

{
    my \$$variable_name;
}

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

## name Exempted scoped lexical variable named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { scoped_lexical_variables => '$capitalization_scheme', scoped_lexical_variable_exemptions => 'bLa.*LaH' }
## cut

{
    my \$bLaHlAhLaH;
}
END_SCOPED_LEXICAL_VARIABLE_TEST

    return;
}


sub emit_file_lexical_variable_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_FILE_LEXICAL_VARIABLE_TEST";

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

## name File lexical variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { file_lexical_variables => '$capitalization_scheme' }
## cut

my \$$variable_name;

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

## name Exempted file lexical variable named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { file_lexical_variables => '$capitalization_scheme', file_lexical_variable_exemptions => 'bLa.*LaH' }
## cut

my \$bLaHlAhLaH;
END_FILE_LEXICAL_VARIABLE_TEST

    return;
}


sub emit_global_variable_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    foreach my $variable_type ( qw< our local > ) {
        print {$test_file} <<"END_FILE_LEXICAL_VARIABLE_TEST";

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

## name "$variable_type" variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { global_variables => '$capitalization_scheme' }
## cut

$variable_type \$$variable_name;

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

## name Exempted "$variable_type" variable named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { global_variables => '$capitalization_scheme', global_variable_exemptions => 'bLa.*LaH' }
## cut

$variable_type \$bLaHlAhLaH;
END_FILE_LEXICAL_VARIABLE_TEST
    }

    return;
}


sub emit_foreach_loop_variable_tests {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_FOREACH_LOOP_VARIABLE_TESTS";

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

## name Local lexical variable as foreach loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

foreach my \$$variable_name (\@_) {
    say \$$variable_name;
}

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

## name State variable as foreach loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

foreach state \$$variable_name (\@_) {
    say \$$variable_name;
}

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

## name Implied local lexical variable as foreach loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

foreach \$$variable_name (\@_) {
    say \$$variable_name;
}

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

## name Global variable as foreach loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { global_variables => '$capitalization_scheme' }
## cut

foreach our \$$variable_name (\@_) {
    say \$$variable_name;
}

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

## name Localized builtin variable
## failures 0
## cut

local \$\@;

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

## name Localized \$\\
## failures 0
## cut

# \$\\ was missing from the built in global exceptions
local \$\\;
END_FOREACH_LOOP_VARIABLE_TESTS

    return;
}


sub emit_c_style_for_loop_variable_tests {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_C_STYLE_FOR_LOOP_VARIABLE_TESTS";

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

## name Local lexical variable as C-style for loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

for (my \$$variable_name = -7; \$$variable_name <= 17; \$$variable_name += 3) {
    say \$$variable_name;
}

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

## name State variable as C-style for loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { local_lexical_variables => '$capitalization_scheme' }
## cut

# Declare the same variable twice in order to catch the case where the
# variable is the second one in the loop definition.
for (state \$$variable_name = -7; \$$variable_name <= 17; \$$variable_name += 3) {
    say \$$variable_name;
}

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

## name Global variable as C-style for loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { global_variables => '$capitalization_scheme' }
## cut

# Declare the same variable twice in order to catch the case where the
# variable is the second one in the loop definition.
for (our \$$variable_name = -7; \$$variable_name <= 17; \$$variable_name += 3) {
    say \$$variable_name;
}

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

## name Localized variable as C-style for loop variable named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { global_variables => '$capitalization_scheme' }
## cut

# Localize the same variable twice in order to catch the case where the
# variable is the second one in the loop definition.
for (local \$$variable_name = -7; \$$variable_name <= 17; \$$variable_name += 3) {
    say \$$variable_name;
}

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

## name Localized builtin variable as C-style for loop variable vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { global_variables => '$capitalization_scheme' }
## cut

for (local \$EVAL_ERROR = -23; \$EVAL_ERROR <= 17; \$EVAL_ERROR += 3) {
    say \$EVAL_ERROR;
}

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

## name Localized variable in another package as C-style for loop variable vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { global_variables => '$capitalization_scheme' }
## cut

for (local \$Foo::Baz = -23; \$Foo::Baz <= 17; \$Foo::Baz += 3) {
    say \$Foo::Baz
}
END_C_STYLE_FOR_LOOP_VARIABLE_TESTS

    return;
}


sub emit_local_lexical_variable_in_io_assignment_in_while_loop_test {
    my ($test_file, $variable_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_LOCAL_LEXICAL_VARIABLE_TEST";

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

## name Local lexical variable, in I/O assignment in while loop, named "$variable_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { subroutines => ':all_lower', local_lexical_variables => '$capitalization_scheme' }
## cut

sub some_subroutine {
    while (my \$$variable_name = <>) {
        say \$$variable_name;
    }
}
END_LOCAL_LEXICAL_VARIABLE_TEST

    return;
}


sub emit_label_test {
    my ($test_file, $label_name, $capitalization_scheme, $failures) = @_;

    print {$test_file} <<"END_LABEL_TEST";

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

## name Label named "$label_name" vs the "$capitalization_scheme" capitalization scheme.
## failures $failures
## parms { labels => '$capitalization_scheme' }
## cut

$label_name:
while ( foo() ) {
    next $label_name;
}

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

## name Exempted label named "bLaHlAhLaH" vs the "$capitalization_scheme" capitalization scheme.
## failures 0
## parms { labels => '$capitalization_scheme', label_exemptions => 'bLa.*LaH' }
## cut

bLaHlAhLaH:
while ( foo() ) {
    next bLaHlAhLaH;
}
END_LABEL_TEST

    return;
}


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

    print {$test_file} <<'END_FOOTER';

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

## name Variable in continue block gets handled as a local lexical and not a scoped lexical.
## failures 1
## parms { local_lexical_variables => ':all_upper', scoped_lexical_variables => ':all_lower' }
## cut

while (blah) {
    blah;
}
continue {
    my $this_should_be_local_and_not_scoped;
}

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

## name Builtin variables and variables in other packages are exempt.
## failures 0
## parms { global_variables => ':all_lower' }
## cut

local $EVAL_ERROR
local @ARGV;
local %INC;
local $Foo::Bar;

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

## name Test customization example in the Capitalization POD passing.
## failures 0
## parms { global_variables => 'G_(?:(?!_)\w)+', global_variable_exemptions => '.*THINGY.*' }
## cut

our $G_FooBar;
our $THINGY;
our @otherTHINGY;

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

## name Test customization example in the Capitalization POD failing.
## failures 4
## parms { global_variables => 'G_(?:(?!_)\w)+', global_variable_exemptions => '.*THINGY.*' }
## cut

our $FooBar;
our $G_;
our $G_foo_bar;
our @THING;

#-----------------------------------------------------------------------------
# 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_FOOTER

    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 :