t/12-fail.t

   1 use strict;
   2
   3 use Test::More qw(no_plan);
   4
   5 use File::Temp qw( tempdir tempfile );
   6 my $perl  = $^X || 'perl';
   7 my $inc = join(' -I ', map { qq{"$_"} } @INC) || '';
   8 $inc = "-I $inc" if $inc;
   9
  10 {
  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 {
  20     my $dir = make_bad_file_1();
  21     run_ok( "all_perl_files_ok( '$dir' )",
  22             qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 5: [\r]/m,
  23             'windows EOL found in tmp file 1' );
  24 }
  25 {
  26     my $dir = make_bad_file_2();
  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 ' );
  30 }
  31 {
  32     my ($dir, $file) = make_bad_file_3();
  33     run_ok( "all_perl_files_ok( '$file' )",
  34             qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 1: [\r] /m,
  35             'windows EOL found in tmp file 3' );
  36 }
  37
  38 {
  39     my $dir = make_bad_file_4();
  40     run_ok( "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )",
  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,
  43             'Trailing ws EOL found in tmp file 4' );
  44 }
  45
  46 sub run_ok {
  47     my ($code, $match, $test_name) = @_;
  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;
  51     my (undef, $outfile) = tempfile();
  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" );
  54     local $/ = undef;
  55     open my $fh, '<', $outfile or die "Can't open $outfile: $!";
  56     my $content = <$fh>;
  57     close $fh or die "Can't close $outfile: $!";
  58     like( $content, $match, $test_name );
  59     unlink $outfile;
  60 }
  61
  62 sub ascii_string {
  63   my $o = "<before \r\n between \r\n after \n normal >";
  64   return $o x 3;
  65 }
  66
  67 sub make_raw_badfile {
  68   my $tmpdir = tempdir( CLEANUP => 1 );
  69   my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX =>  '.tXt' );
  70   binmode $fh, ':raw';
  71   print $fh ascii_string();
  72   close $fh;
  73   return ( $tmpdir, $filename );
  74 }
  75
  76
  77 sub make_bad_file_1 {
  78   my $tmpdir = tempdir( CLEANUP => 1 );
  79   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  80   binmode $fh, ':raw';
  81   my $str = <<"DUMMY";
  82 #!perl
  83
  84 sub main {
  85     # Note that the generated file will have the CRLF expanded in the source
  86     print "Hello!\r\n";
  87 }
  88 DUMMY
  89   print $fh $str;
  90
  91   return $tmpdir;
  92 }
  93
  94 sub make_bad_file_2 {
  95   my $tmpdir = tempdir( CLEANUP => 1 );
  96   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  97   binmode $fh, ':raw';
  98   print $fh <<"DUMMY";
  99 #!perl
 100
 101 =pod
 102
 103 =head1 NAME
 104
 105 test.pL -       A test script
 106 \r\r\r\r\r\r\r\r
 107 =cut
 108
 109 sub main {
 110     print "Hello!\\n";
 111 }
 112 DUMMY
 113   return $tmpdir;
 114 }
 115
 116 sub make_bad_file_3 {
 117   my $tmpdir = tempdir( CLEANUP => 1 );
 118   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
 119   binmode $fh, ':raw';
 120   print $fh <<"DUMMY";
 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
 129 }\r
 130 \r
 131 \r
 132 1;\r
 133 DUMMY
 134   close $fh;
 135   return ($tmpdir, $filename);
 136 }
 137
 138 sub make_bad_file_4 {
 139   my $tmpdir = tempdir( CLEANUP => 1 );
 140   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 141   binmode $fh, ':raw';
 142   print $fh <<'DUMMY';
 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
 156 print $fh qq{    print "Hello!\\n"; \t  \n}; # <-- whitespace
 157 print $fh '}';
 158
 159   return $tmpdir;
 160 }
 161