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' )", |
56109bab |
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) = @_; |
48 | my $line = (caller)[2]; |
49 | die "code containing double quotes is not portable on Win32 in one-liners" if $code =~ /"/; |
91613276 |
50 | my (undef, $outfile) = tempfile(); |
14caafa1 |
51 | is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program at line $line: output redirected" ); |
52 | is( $? >> 8, 1, "test sub program at line $line: exit code is 1" ); |
91613276 |
53 | local $/ = undef; |
14caafa1 |
54 | open my $fh, '<', $outfile or die $!; |
91613276 |
55 | my $content = <$fh>; |
14caafa1 |
56 | like( $content, $match, $test_name ); |
91613276 |
57 | unlink $outfile; |
91613276 |
58 | } |
59 | |
1ec979a8 |
60 | sub ascii_string { |
f17f4176 |
61 | my $o = "<before \r\n between \r\n after \n normal >"; |
62 | return $o x 3; |
63 | } |
64 | |
1ec979a8 |
65 | sub make_raw_badfile { |
66 | my $tmpdir = tempdir( CLEANUP => 1 ); |
67 | my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX => '.tXt' ); |
a953e59d |
68 | binmode $fh, ':raw'; |
f17f4176 |
69 | print $fh ascii_string(); |
70 | close $fh; |
71 | return ( $tmpdir, $filename ); |
72 | } |
73 | |
74 | |
a83ae797 |
75 | sub make_bad_file_1 { |
ece2d635 |
76 | my $tmpdir = tempdir( CLEANUP => 1 ); |
a83ae797 |
77 | my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); |
a953e59d |
78 | binmode $fh, ':raw'; |
f17f4176 |
79 | my $str = <<"DUMMY"; |
a83ae797 |
80 | #!perl |
81 | |
82 | sub main { |
c0662b43 |
83 | # Note that the generated file will have the CRLF expanded in the source |
a83ae797 |
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 |
c0662b43 |
104 | \r\r\r\r\r\r\r\r |
a83ae797 |
105 | =cut |
106 | |
107 | sub main { |
c0662b43 |
108 | print "Hello!\\n"; |
a83ae797 |
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"; |
c0662b43 |
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 |
56109bab |
127 | }\r |
128 | \r |
c0662b43 |
129 | \r |
130 | 1;\r |
a83ae797 |
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'; |
c0662b43 |
140 | print $fh <<'DUMMY'; |
91613276 |
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 | |
c0662b43 |
154 | print $fh qq{ print "Hello!\\n"; \t \n}; # <-- whitespace |
91613276 |
155 | print $fh '}'; |
156 | |
157 | return $tmpdir; |
158 | } |
159 | |