t/12-fail.t

   1 use strict;
   2
   3 use Test::More qw(no_plan);
   4
   5 use File::Temp qw( tempdir tempfile );
   6
   7 my $perl  = $^X || 'perl';
   8 my $inc = join(' -I ', @INC) || '';
   9 $inc = "-I $inc" if $inc;
  10
  11 {
  12     my $dir = make_bad_file_1();
  13     my (undef, $outfile) = tempfile();
  14     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
  15     local $/ = undef;
  16     open my $fh, '<', $outfile or die $!;
  17     my $content = <$fh>;
  18     like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line 4/m, 'windows EOL found in tmp file 1' );
  19     unlink $outfile;
  20 }
  21 {
  22     my $dir = make_bad_file_2();
  23     my (undef, $outfile) = tempfile();
  24     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$dir' )" 2>&1 > $outfile` );
  25     open my $fh, '<', $outfile or die $!;
  26     local $/ = undef;
  27     my $content = <$fh>;
  28     like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file2 ' );
  29     unlink $outfile;
  30 }
  31 {
  32     my ($dir, $file) = make_bad_file_3();
  33     my (undef, $outfile) = tempfile();
  34     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok( '$file' )" 2>&1 > $outfile` );
  35     open my $fh, '<', $outfile or die $!;
  36     local $/ = undef;
  37     my $content = <$fh>;
  38     like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file 3' );
  39     unlink $outfile;
  40 }
  41
  42 {
  43     my $dir = make_bad_file_4();
  44     my (undef, $outfile) = tempfile();
  45     ok( `$perl $inc -MTest::EOL -e "all_perl_files_ok({trailing_whitespace => 1}, '$dir' )" 2>&1 > $outfile` );
  46     open my $fh, '<', $outfile or die $!;
  47     local $/ = undef;
  48     my $content = <$fh>;
  49     like( $content, qr/^not ok 1 - No windows line endings in '[^']*' on line \d+/m, 'windows EOL found in tmp file 4' );
  50     unlink $outfile;
  51 }
  52
  53 sub make_bad_file_1 {
  54   my $tmpdir = tempdir( CLEANUP => 1 );
  55   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  56   print $fh <<"DUMMY";
  57 #!perl
  58
  59 sub main {
  60     print "Hello!\r\n";
  61 }
  62 DUMMY
  63   return $tmpdir;
  64 }
  65
  66 sub make_bad_file_2 {
  67   my $tmpdir = tempdir( CLEANUP => 1 );
  68   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  69   print $fh <<"DUMMY";
  70 #!perl
  71
  72 =pod
  73
  74 =head1 NAME
  75
  76 test.pL -       A test script
  77 \r\r\r\r\r\r\r\r
  78 =cut
  79
  80 sub main {
  81     print "Hello!\n";
  82 }
  83 DUMMY
  84   return $tmpdir;
  85 }
  86
  87 sub make_bad_file_3 {
  88   my $tmpdir = tempdir( CLEANUP => 1 );
  89   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
  90   print $fh <<"DUMMY";
  91 use strict;\r
  92 \r
  93 package My::Test;\r
  94 \r
  95 sub new {\r
  96     my (\$class) = @_;\r
  97     my \$self = bless { }, \$class;\r
  98     return \$self;\r
  99 }\r\r\r\r
 100
 101 \r
 102 1;\r
 103 DUMMY
 104   close $fh;
 105   return ($tmpdir, $filename);
 106 }
 107
 108 sub make_bad_file_4 {
 109   my $tmpdir = tempdir( CLEANUP => 1 );
 110   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 111   print $fh <<"DUMMY";
 112 #!perl
 113
 114 =pod
 115
 116 =head1 NAME
 117
 118 test.pL -       A test script
 119
 120 =cut
 121
 122 sub main {
 123 DUMMY
 124
 125 print $fh qq{    print "Hello!\n";   \n}; # <-- whitespace
 126 print $fh '}';
 127
 128   return $tmpdir;
 129 }
 130