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 {
  47     my $dir = make_bad_file_5();
  48     run_ok( "all_perl_files_ok({trailing_newline => 1}, '$dir' )",
  49             qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 2: Missing "\n" at end of file/m,
  50             'Missing final newline found in tmp file 5' );
  51 }
  52
  53 {
  54     my $dir = make_bad_file_6();
  55     run_ok( "all_perl_files_ok({trailing_newline => 1}, '$dir' )",
  56             qr/^not ok 1 - No incorrect line endings in '[^']*' \Qon line 2: 1 blank line at end of file/m,
  57             'Trailing blank line found in tmp file 6' );
  58 }
  59
  60 {
  61     my $dir = make_bad_file_7();
  62     run_ok( "all_perl_files_ok({
  63                  trailing_whitespace => 1,
  64                  trailing_newline => 1,
  65                  all_reasons => 1,
  66              }, '$dir' )",
  67             qr/^not ok 1 - No incorrect line endings in '[^']*'.*^# line 2: \Q[\s]: [\s]\E.*^# line 2: 1 blank line at end of file.*^# line 2: Missing "\\n" at end of file/ms,
  68             'Trailing blank line found in tmp file 7' );
  69 }
  70
  71 sub run_ok {
  72     my ($code, $match, $test_name) = @_;
  73     my (undef, $file, $line) = caller;
  74     die "code containing double quotes is not portable on Win32 in one-liners at $file $line.\n" if $code =~ /"/;
  75     local $Test::Builder::Level = $Test::Builder::Level + 1;
  76     my (undef, $outfile) = tempfile();
  77     is( `$perl $inc -MTest::EOL -e "$code" > $outfile 2>&1`, '', "test sub program: output redirected" );
  78     is( $? >> 8, 1, "test sub program: exit code is 1" );
  79     local $/ = undef;
  80     open my $fh, '<', $outfile or die "Can't open $outfile: $!";
  81     my $content = <$fh>;
  82     close $fh or die "Can't close $outfile: $!";
  83     like( $content, $match, $test_name );
  84     unlink $outfile;
  85 }
  86
  87 sub ascii_string {
  88   my $o = "<before \r\n between \r\n after \n normal >";
  89   return $o x 3;
  90 }
  91
  92 sub make_raw_badfile {
  93   my $tmpdir = tempdir( CLEANUP => 1 );
  94   my ( $fh, $filename ) = tempfile( DIR => $tmpdir, SUFFIX =>  '.tXt' );
  95   binmode $fh, ':raw';
  96   print $fh ascii_string();
  97   close $fh;
  98   return ( $tmpdir, $filename );
  99 }
 100
 101
 102 sub make_bad_file_1 {
 103   my $tmpdir = tempdir( CLEANUP => 1 );
 104   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 105   binmode $fh, ':raw';
 106   my $str = <<"DUMMY";
 107 #!perl
 108
 109 sub main {
 110     # Note that the generated file will have the CRLF expanded in the source
 111     print "Hello!\r\n";
 112 }
 113 DUMMY
 114   print $fh $str;
 115
 116   return $tmpdir;
 117 }
 118
 119 sub make_bad_file_2 {
 120   my $tmpdir = tempdir( CLEANUP => 1 );
 121   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 122   binmode $fh, ':raw';
 123   print $fh <<"DUMMY";
 124 #!perl
 125
 126 =pod
 127
 128 =head1 NAME
 129
 130 test.pL -       A test script
 131 \r\r\r\r\r\r\r\r
 132 =cut
 133
 134 sub main {
 135     print "Hello!\\n";
 136 }
 137 DUMMY
 138   return $tmpdir;
 139 }
 140
 141 sub make_bad_file_3 {
 142   my $tmpdir = tempdir( CLEANUP => 1 );
 143   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pm' );
 144   binmode $fh, ':raw';
 145   print $fh <<"DUMMY";
 146 use strict;\r
 147 \r
 148 package My::Test;\r
 149 \r
 150 sub new {\r
 151     my (\$class) = \@_;\r
 152     my \$self = bless { }, \$class;\r
 153     return \$self;\r
 154 }\r
 155 \r
 156 \r
 157 1;\r
 158 DUMMY
 159   close $fh;
 160   return ($tmpdir, $filename);
 161 }
 162
 163 sub make_bad_file_4 {
 164   my $tmpdir = tempdir( CLEANUP => 1 );
 165   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 166   binmode $fh, ':raw';
 167   print $fh <<'DUMMY';
 168 #!perl
 169
 170 =pod
 171
 172 =head1 NAME
 173
 174 test.pL -       A test script
 175
 176 =cut
 177
 178 sub main {
 179 DUMMY
 180
 181 print $fh qq{    print "Hello!\\n"; \t  \n}; # <-- whitespace
 182 print $fh '}';
 183
 184   return $tmpdir;
 185 }
 186
 187 sub make_bad_file_5 {
 188   my $tmpdir = tempdir( CLEANUP => 1 );
 189   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 190   binmode $fh, ':raw';
 191   print $fh "one line here\nno EOL here";
 192   close $fh;
 193   return $filename;
 194 }
 195
 196 sub make_bad_file_6 {
 197   my $tmpdir = tempdir( CLEANUP => 1 );
 198   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 199   binmode $fh, ':raw';
 200   print $fh "blank line following here\n \n";
 201   close $fh;
 202   return $filename;
 203 }
 204
 205 sub make_bad_file_7 {
 206   my $tmpdir = tempdir( CLEANUP => 1 );
 207   my ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.pL' );
 208   binmode $fh, ':raw';
 209   print $fh "blank trailing line without newline\n ";
 210   close $fh;
 211   return $filename;
 212 }
 213