Commit | Line | Data |
a83ae797 |
1 | use strict; |
2 | |
3 | use Test::More qw(no_plan); |
4 | |
5 | use File::Temp qw( tempdir tempfile ); |
a83ae797 |
6 | my $perl = $^X || 'perl'; |
996eba3b |
7 | my $inc = join(' -I ', map { qq{"$_"} } @INC) || ''; |
a83ae797 |
8 | $inc = "-I $inc" if $inc; |
9 | |
10 | { |
f17f4176 |
11 | my ( $dir, $filename ) = make_raw_badfile(); |
12 | local $/ = undef; |
13 | open my $fh, '<', $filename or die $!; |
14 | binmode( $fh, ':raw' ); |
15 | my $content = <$fh>; |
1ec979a8 |
16 | is( $content, ascii_string(), 'Data written to file is there when we look for it later' ); |
f17f4176 |
17 | |
18 | } |
19 | { |
a83ae797 |
20 | my $dir = make_bad_file_1(); |
14caafa1 |
21 | run_ok( "all_perl_files_ok( '$dir' )", |
c0662b43 |
22 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 5: [\r]/m, |
14caafa1 |
23 | 'windows EOL found in tmp file 1' ); |
a83ae797 |
24 | } |
a83ae797 |
25 | { |
26 | my $dir = make_bad_file_2(); |
14caafa1 |
27 | run_ok( "all_perl_files_ok( '$dir' )", |
28 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 8: [\r][\r][\r][\r][\r][\r][\r]/m, |
29 | 'windows EOL found in tmp file2 ' ); |
a83ae797 |
30 | } |
a83ae797 |
31 | { |
32 | my ($dir, $file) = make_bad_file_3(); |
14caafa1 |
33 | run_ok( "all_perl_files_ok( '$file' )", |
d3afcf90 |
34 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 1: [\r]/m, |
14caafa1 |
35 | 'windows EOL found in tmp file 3' ); |
a83ae797 |
36 | } |
37 | |
91613276 |
38 | { |
39 | my $dir = make_bad_file_4(); |
14caafa1 |
40 | run_ok( "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )", |
c0662b43 |
41 | # Note that line number will be 13 |
42 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 12: [\s][\t][\s][\s]/m, |
14caafa1 |
43 | 'Trailing ws EOL found in tmp file 4' ); |
44 | } |
45 | |
131289da |
46 | { |
47 | my $dir = make_bad_file_5(); |
48 | run_ok( "all_perl_files_ok({trailing_newline => 1}, '$dir' )", |
49 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 2: Missing "\n" at end of file/m, |
50 | 'Missing final newline found in tmp file 5' ); |
51 | } |
52 | |
53 | { |
54 | my $dir = make_bad_file_6(); |
55 | run_ok( "all_perl_files_ok({trailing_newline => 1}, '$dir' )", |
56 | qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 2: 1 blank line at end of file/m, |
57 | 'Trailing blank line found in tmp file 6' ); |
58 | } |
59 | |
60 | { |
61 | my $dir = make_bad_file_7(); |
62 | run_ok( "all_perl_files_ok({ |
63 | trailing_whitespace => 1, |
64 | trailing_newline => 1, |
65 | all_reasons => 1, |
66 | }, '$dir' )", |
67 | qr/^not ok 1 - No incorrect line endings in '[^']*'.*^# line 2: \Q[\s]: [\s]\E.*^# line 2: 1 blank line at end of file.*^# line 2: Missing "\\n" at end of file/ms, |
68 | 'Trailing blank line found in tmp file 7' ); |
69 | } |
70 | |
14caafa1 |
71 | sub run_ok { |
72 | my ($code, $match, $test_name) = @_; |
51e6a8a9 |
73 | my (undef, $file, $line) = caller; |
74 | die "code containing double quotes is not portable on Win32 in one-liners at $file $line.\n" if $code =~ /"/; |
75 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
91613276 |
76 | my (undef, $outfile) = tempfile(); |
51e6a8a9 |
77 | is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program: output redirected" ); |
78 | is( $? >> 8, 1, "test sub program: exit code is 1" ); |
91613276 |
79 | local $/ = undef; |
51e6a8a9 |
80 | open my $fh, '<', $outfile or die "Can't open $outfile: $!"; |
91613276 |
81 | my $content = <$fh>; |
51e6a8a9 |
82 | close $fh or die "Can't close $outfile: $!"; |
14caafa1 |
83 | like( $content, $match, $test_name ); |
91613276 |
84 | unlink $outfile; |
91613276 |
85 | } |
86 | |
1ec979a8 |
87 | sub ascii_string { |
f17f4176 |
88 | my $o = "<before \r\n between \r\n after \n normal >"; |
89 | return $o x 3; |
90 | } |
91 | |
1ec979a8 |
92 | sub make_raw_badfile { |
93 | my $tmpdir = tempdir( CLEANUP => 1 ); |
94 | my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX => '.tXt' ); |
a953e59d |
95 | binmode $fh, ':raw'; |
f17f4176 |
96 | print $fh ascii_string(); |
97 | close $fh; |
98 | return ( $tmpdir, $filename ); |
99 | } |
100 | |
101 | |
a83ae797 |
102 | sub make_bad_file_1 { |
ece2d635 |
103 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
104 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
105 | binmode $fh, ':raw'; |
f17f4176 |
106 | my $str = <<"DUMMY"; |
a83ae797 |
107 | #!perl |
108 | |
109 | sub main { |
c0662b43 |
110 | # Note that the generated file will have the CRLF expanded in the source |
a83ae797 |
111 | print "Hello!\r\n"; |
91613276 |
112 | } |
a83ae797 |
113 | DUMMY |
f17f4176 |
114 | print $fh $str; |
115 | |
a83ae797 |
116 | return $tmpdir; |
117 | } |
118 | |
119 | sub make_bad_file_2 { |
ece2d635 |
120 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
121 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
122 | binmode $fh, ':raw'; |
a83ae797 |
123 | print $fh <<"DUMMY"; |
124 | #!perl |
125 | |
126 | =pod |
127 | |
128 | =head1 NAME |
129 | |
130 | test.pL - A test script |
c0662b43 |
131 | \r\r\r\r\r\r\r\r |
a83ae797 |
132 | =cut |
133 | |
134 | sub main { |
c0662b43 |
135 | print "Hello!\\n"; |
a83ae797 |
136 | } |
137 | DUMMY |
138 | return $tmpdir; |
139 | } |
140 | |
141 | sub make_bad_file_3 { |
ece2d635 |
142 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
143 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' ); |
a953e59d |
144 | binmode $fh, ':raw'; |
a83ae797 |
145 | print $fh <<"DUMMY"; |
c0662b43 |
146 | use strict;\r |
147 | \r |
148 | package My::Test;\r |
149 | \r |
150 | sub new {\r |
151 | my (\$class) = \@_;\r |
152 | my \$self = bless { }, \$class;\r |
153 | return \$self;\r |
56109bab |
154 | }\r |
155 | \r |
c0662b43 |
156 | \r |
157 | 1;\r |
a83ae797 |
158 | DUMMY |
159 | close $fh; |
160 | return ($tmpdir, $filename); |
161 | } |
162 | |
91613276 |
163 | sub make_bad_file_4 { |
ece2d635 |
164 | my $tmpdir = tempdir( CLEANUP => 1 ); |
91613276 |
165 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
166 | binmode $fh, ':raw'; |
c0662b43 |
167 | print $fh <<'DUMMY'; |
91613276 |
168 | #!perl |
169 | |
170 | =pod |
171 | |
172 | =head1 NAME |
173 | |
174 | test.pL - A test script |
175 | |
176 | =cut |
177 | |
178 | sub main { |
179 | DUMMY |
180 | |
c0662b43 |
181 | print $fh qq{ print "Hello!\\n"; \t \n}; # <-- whitespace |
91613276 |
182 | print $fh '}'; |
183 | |
184 | return $tmpdir; |
185 | } |
186 | |
131289da |
187 | sub make_bad_file_5 { |
188 | my $tmpdir = tempdir( CLEANUP => 1 ); |
189 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
190 | binmode $fh, ':raw'; |
191 | print $fh "one line here\nno EOL here"; |
192 | close $fh; |
193 | return $filename; |
194 | } |
195 | |
196 | sub make_bad_file_6 { |
197 | my $tmpdir = tempdir( CLEANUP => 1 ); |
198 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
199 | binmode $fh, ':raw'; |
200 | print $fh "blank line following here\n \n"; |
201 | close $fh; |
202 | return $filename; |
203 | } |
204 | |
205 | sub make_bad_file_7 { |
206 | my $tmpdir = tempdir( CLEANUP => 1 ); |
207 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
208 | binmode $fh, ':raw'; |
209 | print $fh "blank trailing line without newline\n "; |
210 | close $fh; |
211 | return $filename; |
212 | } |
213 | |