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 9: [\r][\r][\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 $line = (caller)[2];
  49     die "code containing double quotes is not portable on Win32 in one-liners" if $code =~ /"/;
  50     my (undef, $outfile) = tempfile();
  51     is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program at line $line: output redirected" );
  52     is( $? >> 8, 1, "test sub program at line $line: exit code is 1" );
  53     local $/ = undef;
  54     open my $fh, '<', $outfile or die $!;
  55     my $content = <$fh>;
  56     like( $content, $match, $test_name );
  57     unlink $outfile;
  58 }
  59
  60 sub ascii_string {
  61   my $o = "<before \r\n between \r\n after \n normal >";
  62   return $o x 3;
  63 }
  64
  65 sub make_raw_badfile {
  66   my $tmpdir = tempdir( CLEANUP => 1 );
  67   my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX =>  '.tXt' );
  68   binmode $fh, ':raw';
  69   print $fh ascii_string();
  70   close $fh;
  71   return ( $tmpdir, $filename );
  72 }
  73
  74
  75 sub make_bad_file_1 {
  76   my $tmpdir = tempdir( CLEANUP => 1 );
  77   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
  78   binmode $fh, ':raw';
  79   my $str = <<"DUMMY";
  80 #!perl
  81
  82 sub main {
  83     # Note that the generated file will have the CRLF expanded in the source
  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