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