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>; |
16 | is( $content, ascii_string(), 'Data written to file is there when we look for it later' ); |
17 | |
18 | } |
19 | { |
a83ae797 |
20 | my $dir = make_bad_file_1(); |
21 | my (undef, $outfile) = tempfile(); |
f7dcf484 |
22 | ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" > $outfile 2>&1` ); |
a83ae797 |
23 | local $/ = undef; |
24 | open my $fh, '<', $outfile or die $!; |
25 | my $content = <$fh>; |
939ef613 |
26 | like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 4: [\r]/m, 'windows EOL found in tmp file 1' ); |
02016826 |
27 | unlink $outfile; |
a83ae797 |
28 | } |
a83ae797 |
29 | { |
30 | my $dir = make_bad_file_2(); |
31 | my (undef, $outfile) = tempfile(); |
f7dcf484 |
32 | ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" > $outfile 2>&1` ); |
a83ae797 |
33 | open my $fh, '<', $outfile or die $!; |
34 | local $/ = undef; |
35 | my $content = <$fh>; |
939ef613 |
36 | like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 8: [\r][\r][\r][\r][\r][\r][\r]/m, 'windows EOL found in tmp file2 ' ); |
a83ae797 |
37 | unlink $outfile; |
a83ae797 |
38 | } |
a83ae797 |
39 | { |
40 | my ($dir, $file) = make_bad_file_3(); |
41 | my (undef, $outfile) = tempfile(); |
f7dcf484 |
42 | ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$file' )" > $outfile 2>&1` ); |
a83ae797 |
43 | open my $fh, '<', $outfile or die $!; |
44 | local $/ = undef; |
45 | my $content = <$fh>; |
939ef613 |
46 | like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 9: [\r][\r][\r]/m, 'windows EOL found in tmp file 3' ); |
a83ae797 |
47 | unlink $outfile; |
a83ae797 |
48 | } |
49 | |
91613276 |
50 | { |
51 | my $dir = make_bad_file_4(); |
52 | my (undef, $outfile) = tempfile(); |
f7dcf484 |
53 | ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )" > $outfile 2>&1` ); |
91613276 |
54 | open my $fh, '<', $outfile or die $!; |
55 | local $/ = undef; |
56 | my $content = <$fh>; |
939ef613 |
57 | like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 13: [\s][\t][\s][\s]/m, 'Trailing ws EOL found in tmp file 4' ); |
91613276 |
58 | unlink $outfile; |
91613276 |
59 | } |
60 | |
f17f4176 |
61 | sub ascii_string { |
62 | my $o = "<before \r\n between \r\n after \n normal >"; |
63 | return $o x 3; |
64 | } |
65 | |
66 | sub make_raw_badfile { |
67 | my $tmpdir = tempdir( CLEANUP => 1 ); |
68 | my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX => '.tXt' ); |
a953e59d |
69 | binmode $fh, ':raw'; |
f17f4176 |
70 | print $fh ascii_string(); |
71 | close $fh; |
72 | return ( $tmpdir, $filename ); |
73 | } |
74 | |
75 | |
a83ae797 |
76 | sub make_bad_file_1 { |
ece2d635 |
77 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
78 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
79 | binmode $fh, ':raw'; |
f17f4176 |
80 | my $str = <<"DUMMY"; |
a83ae797 |
81 | #!perl |
82 | |
83 | sub main { |
84 | print "Hello!\r\n"; |
91613276 |
85 | } |
a83ae797 |
86 | DUMMY |
f17f4176 |
87 | print $fh $str; |
88 | |
a83ae797 |
89 | return $tmpdir; |
90 | } |
91 | |
92 | sub make_bad_file_2 { |
ece2d635 |
93 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
94 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
95 | binmode $fh, ':raw'; |
a83ae797 |
96 | print $fh <<"DUMMY"; |
97 | #!perl |
98 | |
99 | =pod |
100 | |
101 | =head1 NAME |
102 | |
103 | test.pL - A test script |
02016826 |
104 | \r\r\r\r\r\r\r\r |
a83ae797 |
105 | =cut |
106 | |
107 | sub main { |
108 | print "Hello!\n"; |
109 | } |
110 | DUMMY |
111 | return $tmpdir; |
112 | } |
113 | |
114 | sub make_bad_file_3 { |
ece2d635 |
115 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
116 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' ); |
a953e59d |
117 | binmode $fh, ':raw'; |
a83ae797 |
118 | print $fh <<"DUMMY"; |
119 | use strict;\r |
120 | \r |
121 | package My::Test;\r |
122 | \r |
123 | sub new {\r |
124 | my (\$class) = @_;\r |
125 | my \$self = bless { }, \$class;\r |
126 | return \$self;\r |
02016826 |
127 | }\r\r\r\r |
128 | |
a83ae797 |
129 | \r |
130 | 1;\r |
131 | DUMMY |
132 | close $fh; |
133 | return ($tmpdir, $filename); |
134 | } |
135 | |
91613276 |
136 | sub make_bad_file_4 { |
ece2d635 |
137 | my $tmpdir = tempdir( CLEANUP => 1 ); |
91613276 |
138 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
139 | binmode $fh, ':raw'; |
91613276 |
140 | print $fh <<"DUMMY"; |
141 | #!perl |
142 | |
143 | =pod |
144 | |
145 | =head1 NAME |
146 | |
147 | test.pL - A test script |
148 | |
149 | =cut |
150 | |
151 | sub main { |
152 | DUMMY |
153 | |
939ef613 |
154 | print $fh qq{ print "Hello!\n"; \t \n}; # <-- whitespace |
91613276 |
155 | print $fh '}'; |
156 | |
157 | return $tmpdir; |
158 | } |
159 | |