X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F12-fail.t;h=1378779e85713296b66f5507a2216dd6be8e4e52;hb=51e6a8a9b063429fb80b146263dcba725749607d;hp=91cc6b8d983fab5ea0deafa9dbac845d006f7103;hpb=916132761bb9b03c75b161bfbe5a3ffcc86fe241;p=catagits%2FTest-EOL.git diff --git a/t/12-fail.t b/t/12-fail.t index 91cc6b8..1378779 100644 --- a/t/12-fail.t +++ b/t/12-fail.t @@ -3,73 +3,98 @@ use strict; use Test::More qw(no_plan); use File::Temp qw( tempdir tempfile ); - my $perl = $^X || 'perl'; -my $inc = join(' -I ', @INC) || ''; +my $inc = join(' -I ', map { qq{"$_"} } @INC) || ''; $inc = "-I $inc" if $inc; { - my $dir = make_bad_file_1(); - my (undef, $outfile) = tempfile(); - ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` ); + my ( $dir, $filename ) = make_raw_badfile(); local $/ = undef; - open my $fh, '<', $outfile or die $!; + open my $fh, '<', $filename or die $!; + binmode( $fh, ':raw' ); my $content = <$fh>; - like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line 4/m, 'windows EOL found in tmp file 1' ); - unlink $outfile; - system("rm -rf $dir"); + is( $content, ascii_string(), 'Data written to file is there when we look for it later' ); + +} +{ + my $dir = make_bad_file_1(); + run_ok( "all_perl_files_ok( '$dir' )", + qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 5: [\r]/m, + 'windows EOL found in tmp file 1' ); } { my $dir = make_bad_file_2(); - my (undef, $outfile) = tempfile(); - ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` ); - open my $fh, '<', $outfile or die $!; - local $/ = undef; - my $content = <$fh>; - like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file2 ' ); - unlink $outfile; - system("rm -rf $dir"); + run_ok( "all_perl_files_ok( '$dir' )", + 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 ' ); } { my ($dir, $file) = make_bad_file_3(); - my (undef, $outfile) = tempfile(); - ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$file' )" 2>&1 > $outfile` ); - open my $fh, '<', $outfile or die $!; - local $/ = undef; - my $content = <$fh>; - like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file 3' ); - unlink $outfile; - system("rm -rf $dir"); + run_ok( "all_perl_files_ok( '$file' )", + qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 1: [\r] /m, + 'windows EOL found in tmp file 3' ); } { my $dir = make_bad_file_4(); + run_ok( "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )", + # Note that line number will be 13 + qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 12: [\s][\t][\s][\s]/m, + 'Trailing ws EOL found in tmp file 4' ); +} + +sub run_ok { + my ($code, $match, $test_name) = @_; + my (undef, $file, $line) = caller; + die "code containing double quotes is not portable on Win32 in one-liners at $file $line.\n" if $code =~ /"/; + local $Test::Builder::Level = $Test::Builder::Level + 1; my (undef, $outfile) = tempfile(); - ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )" 2>&1 > $outfile` ); - open my $fh, '<', $outfile or die $!; + is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program: output redirected" ); + is( $? >> 8, 1, "test sub program: exit code is 1" ); local $/ = undef; + open my $fh, '<', $outfile or die "Can't open $outfile: $!"; my $content = <$fh>; - like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file 4' ); + close $fh or die "Can't close $outfile: $!"; + like( $content, $match, $test_name ); unlink $outfile; - system("rm -rf $dir"); } +sub ascii_string { + my $o = ""; + return $o x 3; +} + +sub make_raw_badfile { + my $tmpdir = tempdir( CLEANUP => 1 ); + my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX => '.tXt' ); + binmode $fh, ':raw'; + print $fh ascii_string(); + close $fh; + return ( $tmpdir, $filename ); +} + + sub make_bad_file_1 { - my $tmpdir = tempdir(); + my $tmpdir = tempdir( CLEANUP => 1 ); my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); - print $fh <<"DUMMY"; + binmode $fh, ':raw'; + my $str = <<"DUMMY"; #!perl sub main { + # Note that the generated file will have the CRLF expanded in the source print "Hello!\r\n"; } DUMMY + print $fh $str; + return $tmpdir; } sub make_bad_file_2 { - my $tmpdir = tempdir(); + my $tmpdir = tempdir( CLEANUP => 1 ); my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); + binmode $fh, ':raw'; print $fh <<"DUMMY"; #!perl @@ -78,41 +103,43 @@ sub make_bad_file_2 { =head1 NAME test.pL - A test script - +\r\r\r\r\r\r\r\r =cut sub main { - print "Hello!\n"; + print "Hello!\\n"; } DUMMY return $tmpdir; } sub make_bad_file_3 { - my $tmpdir = tempdir(); + my $tmpdir = tempdir( CLEANUP => 1 ); my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' ); + binmode $fh, ':raw'; print $fh <<"DUMMY"; -use strict; - -package My::Test; - -sub new { - my (\$class) = @_; - my \$self = bless { }, \$class; - return \$self; -} - - -1; +use strict;\r +\r +package My::Test;\r +\r +sub new {\r + my (\$class) = \@_;\r + my \$self = bless { }, \$class;\r + return \$self;\r +}\r +\r +\r +1;\r DUMMY close $fh; return ($tmpdir, $filename); } sub make_bad_file_4 { - my $tmpdir = tempdir(); + my $tmpdir = tempdir( CLEANUP => 1 ); my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); - print $fh <<"DUMMY"; + binmode $fh, ':raw'; + print $fh <<'DUMMY'; #!perl =pod @@ -126,7 +153,7 @@ test.pL - A test script sub main { DUMMY -print $fh qq{ print "Hello!\n"; \n}; # <-- whitespace +print $fh qq{ print "Hello!\\n"; \t \n}; # <-- whitespace print $fh '}'; return $tmpdir;