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 | |
46 | sub run_ok { |
47 | my ($code, $match, $test_name) = @_; |
51e6a8a9 |
48 | my (undef, $file, $line) = caller; |
49 | die "code containing double quotes is not portable on Win32 in one-liners at $file $line.\n" if $code =~ /"/; |
50 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
91613276 |
51 | my (undef, $outfile) = tempfile(); |
51e6a8a9 |
52 | is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program: output redirected" ); |
53 | is( $? >> 8, 1, "test sub program: exit code is 1" ); |
91613276 |
54 | local $/ = undef; |
51e6a8a9 |
55 | open my $fh, '<', $outfile or die "Can't open $outfile: $!"; |
91613276 |
56 | my $content = <$fh>; |
51e6a8a9 |
57 | close $fh or die "Can't close $outfile: $!"; |
14caafa1 |
58 | like( $content, $match, $test_name ); |
91613276 |
59 | unlink $outfile; |
91613276 |
60 | } |
61 | |
1ec979a8 |
62 | sub ascii_string { |
f17f4176 |
63 | my $o = "<before \r\n between \r\n after \n normal >"; |
64 | return $o x 3; |
65 | } |
66 | |
1ec979a8 |
67 | sub make_raw_badfile { |
68 | my $tmpdir = tempdir( CLEANUP => 1 ); |
69 | my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX => '.tXt' ); |
a953e59d |
70 | binmode $fh, ':raw'; |
f17f4176 |
71 | print $fh ascii_string(); |
72 | close $fh; |
73 | return ( $tmpdir, $filename ); |
74 | } |
75 | |
76 | |
a83ae797 |
77 | sub make_bad_file_1 { |
ece2d635 |
78 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
79 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
80 | binmode $fh, ':raw'; |
f17f4176 |
81 | my $str = <<"DUMMY"; |
a83ae797 |
82 | #!perl |
83 | |
84 | sub main { |
c0662b43 |
85 | # Note that the generated file will have the CRLF expanded in the source |
a83ae797 |
86 | print "Hello!\r\n"; |
91613276 |
87 | } |
a83ae797 |
88 | DUMMY |
f17f4176 |
89 | print $fh $str; |
90 | |
a83ae797 |
91 | return $tmpdir; |
92 | } |
93 | |
94 | sub make_bad_file_2 { |
ece2d635 |
95 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
96 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
97 | binmode $fh, ':raw'; |
a83ae797 |
98 | print $fh <<"DUMMY"; |
99 | #!perl |
100 | |
101 | =pod |
102 | |
103 | =head1 NAME |
104 | |
105 | test.pL - A test script |
c0662b43 |
106 | \r\r\r\r\r\r\r\r |
a83ae797 |
107 | =cut |
108 | |
109 | sub main { |
c0662b43 |
110 | print "Hello!\\n"; |
a83ae797 |
111 | } |
112 | DUMMY |
113 | return $tmpdir; |
114 | } |
115 | |
116 | sub make_bad_file_3 { |
ece2d635 |
117 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
118 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' ); |
a953e59d |
119 | binmode $fh, ':raw'; |
a83ae797 |
120 | print $fh <<"DUMMY"; |
c0662b43 |
121 | use strict;\r |
122 | \r |
123 | package My::Test;\r |
124 | \r |
125 | sub new {\r |
126 | my (\$class) = \@_;\r |
127 | my \$self = bless { }, \$class;\r |
128 | return \$self;\r |
56109bab |
129 | }\r |
130 | \r |
c0662b43 |
131 | \r |
132 | 1;\r |
a83ae797 |
133 | DUMMY |
134 | close $fh; |
135 | return ($tmpdir, $filename); |
136 | } |
137 | |
91613276 |
138 | sub make_bad_file_4 { |
ece2d635 |
139 | my $tmpdir = tempdir( CLEANUP => 1 ); |
91613276 |
140 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
141 | binmode $fh, ':raw'; |
c0662b43 |
142 | print $fh <<'DUMMY'; |
91613276 |
143 | #!perl |
144 | |
145 | =pod |
146 | |
147 | =head1 NAME |
148 | |
149 | test.pL - A test script |
150 | |
151 | =cut |
152 | |
153 | sub main { |
154 | DUMMY |
155 | |
c0662b43 |
156 | print $fh qq{ print "Hello!\\n"; \t \n}; # <-- whitespace |
91613276 |
157 | print $fh '}'; |
158 | |
159 | return $tmpdir; |
160 | } |
161 | |