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     my (undef, $outfile) = tempfile();
  22     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
  23     local $/ = undef;
  24     open my $fh, '<', $outfile or die $!;
  25     my $content = <$fh>;
  26     like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 4: [\r]/m, 'windows EOL found in tmp file 1' );
  27     unlink $outfile;
  28 }
  29 {
  30     my $dir = make_bad_file_2();
  31     my (undef, $outfile) = tempfile();
  32     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
  33     open my $fh, '<', $outfile or die $!;
  34     local $/ = undef;
  35     my $content = <$fh>;
  36     like( $content, 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 ' );
  37     unlink $outfile;
  38 }
  39 {
  40     my ($dir, $file) = make_bad_file_3();
  41     my (undef, $outfile) = tempfile();
  42     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$file' )" 2>&1 > $outfile` );
  43     open my $fh, '<', $outfile or die $!;
  44     local $/ = undef;
  45     my $content = <$fh>;
  46     like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 9: [\r][\r][\r]/m, 'windows EOL found in tmp file 3' );
  47     unlink $outfile;
  48 }
  49
  50 {
  51     my $dir = make_bad_file_4();
  52     my (undef, $outfile) = tempfile();
  53     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )" 2>&1 > $outfile` );
  54     open my $fh, '<', $outfile or die $!;
  55     local $/ = undef;
  56     my $content = <$fh>;
  57     like( $content, qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 13: [\s][\t][\s][\s]/m, 'Trailing ws EOL found in tmp file 4' );
  58     unlink $outfile;
  59 }
  60
  61 sub ascii_string {
  62   my $o = "<before \r\n between \r\n after \n normal >";
  63   return $o x 3;
  64 }
  65
  66 sub make_raw_badfile {
  67   my $tmpdir = tempdir( CLEANUP => 1 );
  68   my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX =>  '.tXt' );
  69   binmode $fh, ':raw';
  70   print $fh ascii_string();
  71   close $fh;
  72   return ( $tmpdir, $filename );
  73 }
  74
  75
  76 sub make_bad_file_1 {
  77   my $tmpdir = tempdir( CLEANUP => 1 );
  78   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  79   binmode $fh, ':raw';
  80   my $str = <<"DUMMY";
  81 #!perl
  82
  83 sub main {
  84     print "Hello!\r\n";
  85 }
  86 DUMMY
  87   print $fh $str;
  88
  89   return $tmpdir;
  90 }
  91
  92 sub make_bad_file_2 {
  93   my $tmpdir = tempdir( CLEANUP => 1 );
  94   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  95   binmode $fh, ':raw';
  96   print $fh <<"DUMMY";
  97 #!perl
  98
  99 =pod
 100
 101 =head1 NAME
 102
 103 test.pL -       A test script
 104 \r\r\r\r\r\r\r\r
 105 =cut
 106
 107 sub main {
 108     print "Hello!\n";
 109 }
 110 DUMMY
 111   return $tmpdir;
 112 }
 113
 114 sub make_bad_file_3 {
 115   my $tmpdir = tempdir( CLEANUP => 1 );
 116   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
 117   binmode $fh, ':raw';
 118   print $fh <<"DUMMY";
 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
 127 }\r\r\r\r
 128
 129 \r
 130 1;\r
 131 DUMMY
 132   close $fh;
 133   return ($tmpdir, $filename);
 134 }
 135
 136 sub make_bad_file_4 {
 137   my $tmpdir = tempdir( CLEANUP => 1 );
 138   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 139   binmode $fh, ':raw';
 140   print $fh <<"DUMMY";
 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
 154 print $fh qq{    print "Hello!\n"; \t  \n}; # <-- whitespace
 155 print $fh '}';
 156
 157   return $tmpdir;
 158 }
 159