Login
Get generation of t/NamingConventions/Capitalization.run in place.
[gknop/Perl-Critic.git] / t / NamingConventions / Capitalization.run.PL
1 #!/usr/bin/env perl
2
3 use 5.006001;
4 use strict;
5 use warnings;
6
7 use English qw< -no_match_vars >;
8 use Carp qw< confess >;
9
10 use Carp qw<  confess >;
11 use Fatal qw<  open close >;
12
13 our $VERSION = '1.093_01';
14
15
16
17 my $this_program = __FILE__;
18 (my $test_file_name = $this_program) =~ s/ [.] PL \z //xms;
19 if ($this_program eq $test_file_name) {
20     confess
21         'Was not able to figure out the name of the file to generate.'
22         . "This program: $this_program.";
23 }
24
25 print "\n\nGenerating $test_file_name.\n";
26
27
28
29 open my $test_file, '>', $test_file_name    ## no critic (RequireBriefOpen)
30     or confess "Could not open $test_file_name: $ERRNO";
31
32
33 print {$test_file} <<"END_HEADER";
34 # Do not edit!!!  This test suite generated by $this_program.
35 END_HEADER
36
37 emit_simple_tests($test_file);
38 emit_footer($test_file);
39
40 close $test_file;
41 print "Done.\n\n";
42
43 #-----------------------------------------------------------------------------
44
45 sub emit_simple_tests {
46     my ($test_file) = @_;
47
48     print {$test_file} <<'END_SIMPLE_TESTS';
49 #-----------------------------------------------------------------------------
50
51 ## name Basic Passes
52 ## failures 0
53 ## cut
54
55 my  $foo;
56 our $bar;
57 my($foo, $bar) = ("BLEH", "BLEH");
58 my @foo;
59 my %bar;
60 sub foo {}
61
62 my  $foo123;
63 my  $foo123bar;
64 sub foo123 {}
65 sub foo123bar {}
66
67 package This::SomeThing;
68 package This;
69 package This::Thing;
70 package Acme::12345;
71 package YYZ;
72
73 #-----------------------------------------------------------------------------
74
75 ## name Basic Failures
76 ## failures 14
77 ## cut
78
79 my  $Foo;
80 our $Bar;
81 my  @Foo;
82 my  %Bar;
83 sub Foo {}
84
85 my  $foo_Bar;
86 sub foo_Bar {}
87
88 my  $FooBar;
89 sub FooBar {}
90
91 my  $foo123Bar;
92 sub foo123Bar {}
93
94 package pragma;
95 package Foo::baz;
96 package baz::FooBar;
97
98 #-----------------------------------------------------------------------------
99
100 ## name Special case: main
101 ## failures 0
102 ## cut
103
104 package main;
105
106 #-----------------------------------------------------------------------------
107
108 ## name Combined passes and fails
109 ## failures 2
110 ## cut
111
112 my($foo, $Bar);
113 our($Bar, $foo);
114
115 #-----------------------------------------------------------------------------
116
117 ## name Variables from other packages should pass 
118 ## failures 0
119 ## cut
120
121 local $Other::Package::Foo;
122 $Other::Package::Foo;
123
124 #-----------------------------------------------------------------------------
125
126 ## name Only cares about declarations
127 ## failures 0
128 ## cut
129 Foo();
130 $Foo = 42;
131
132 #-----------------------------------------------------------------------------
133
134 ## name Constants must be all caps, passes
135 ## failures 0
136 ## cut
137
138 Readonly::Scalar my $CONSTANT = 23;
139
140 #-----------------------------------------------------------------------------
141
142 ## name Constants must be all caps, failures
143 ## TODO Detect whether a scalar is constant or not
144 ## failures 4
145 ## cut
146
147 Readonly::Scalar my $Foo = 23;
148 Readonly::Scalar my $foo = 23;
149 Readonly::Scalar my $fooBAR = 23;
150 my $CONSTANT = 23;
151 END_SIMPLE_TESTS
152
153     return;
154 }
155
156
157 sub emit_footer {
158
159     print {$test_file} <<'END_FOOTER';
160
161 #-----------------------------------------------------------------------------
162 # Local Variables:
163 #   mode: cperl
164 #   cperl-indent-level: 4
165 #   fill-column: 78
166 #   indent-tabs-mode: nil
167 #   c-indentation-style: bsd
168 # End:
169 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
170 END_FOOTER
171
172     return;
173 }
174
175 #-----------------------------------------------------------------------------
176 # Local Variables:
177 #   mode: cperl
178 #   cperl-indent-level: 4
179 #   fill-column: 78
180 #   indent-tabs-mode: nil
181 #   c-indentation-style: bsd
182 # End:
183 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :