X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F12-fail.t;h=1378779e85713296b66f5507a2216dd6be8e4e52;hb=51e6a8a9b063429fb80b146263dcba725749607d;hp=0ba17c66fbb5b89fb6b1fe8569eee3efcb4420e8;hpb=14caafa1672403a6f27ba56997ddf0e6a8f43dc5;p=catagits%2FTest-EOL.git diff --git a/t/12-fail.t b/t/12-fail.t index 0ba17c6..1378779 100644 --- a/t/12-fail.t +++ b/t/12-fail.t @@ -13,13 +13,13 @@ $inc = "-I $inc" if $inc; open my $fh, '<', $filename or die $!; binmode( $fh, ':raw' ); my $content = <$fh>; - is( $content, ascii_string(), 'Data written to file is there when we look for it later' ); + 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 4: [\r]/m, + qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 5: [\r]/m, 'windows EOL found in tmp file 1' ); } { @@ -31,39 +31,42 @@ $inc = "-I $inc" if $inc; { my ($dir, $file) = make_bad_file_3(); run_ok( "all_perl_files_ok( '$file' )", - qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 9: [\r][\r][\r]/m, + 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' )", - qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 13: [\s][\t][\s][\s]/m, + # 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 $line = (caller)[2]; - die "code containing double quotes is not portable on Win32 in one-liners" if $code =~ /"/; + 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(); - is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program at line $line: output redirected" ); - is( $? >> 8, 1, "test sub program at line $line: exit code is 1" ); + 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 $!; + open my $fh, '<', $outfile or die "Can't open $outfile: $!"; my $content = <$fh>; + close $fh or die "Can't close $outfile: $!"; like( $content, $match, $test_name ); unlink $outfile; } -sub ascii_string { +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' ); +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; @@ -79,6 +82,7 @@ sub make_bad_file_1 { #!perl sub main { + # Note that the generated file will have the CRLF expanded in the source print "Hello!\r\n"; } DUMMY @@ -99,11 +103,11 @@ 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; @@ -114,18 +118,18 @@ sub make_bad_file_3 { 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); @@ -135,7 +139,7 @@ sub make_bad_file_4 { my $tmpdir = tempdir( CLEANUP => 1 ); my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' ); binmode $fh, ':raw'; - print $fh <<"DUMMY"; + print $fh <<'DUMMY'; #!perl =pod @@ -149,7 +153,7 @@ test.pL - A test script sub main { DUMMY -print $fh qq{ print "Hello!\n"; \t \n}; # <-- whitespace +print $fh qq{ print "Hello!\\n"; \t \n}; # <-- whitespace print $fh '}'; return $tmpdir;