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