t/testwide-passthrough.t

   1 use strict;
   2 use warnings;
   3 use utf8;
   4
   5 use FindBin qw($Bin);
   6 use File::Temp qw(tempfile);
   7 use Test::More;
   8
   9 BEGIN { unshift @INC, "./" }
  10 use Perl::Tidy;
  11
  12 # This tests the -eos (--encode-output-strings) which was added for issue
  13 # git #83 to fix an issue with tidyall.
  14
  15 # NOTE: to prevent automatic conversion of line endings LF to CRLF under github
  16 # Actions with Windows, which would cause test failure, it is essential that
  17 # there be a file 't/.gitattributes' with the line:
  18 # * -text
  19
  20 # The test file has no tidying needs but is UTF-8 encoded, so all passes
  21 # through perltidy should read/write identical contents (previously only
  22 # file test behaved correctly)
  23
  24 # Test::More in perl versions before 5.10 does not have sub note
  25 # so just skip this test
  26
  27 plan( tests => 6 );
  28
  29 test_all();
  30
  31 sub my_note {
  32     my ($msg) = @_;
  33
  34     # try to work around problem where sub Test::More::note does not exist
  35     # in older versions of perl
  36     if ($] >= 5.010) {
  37        note($msg);
  38     }
  39     return;
  40 }
  41
  42
  43 sub test_all {
  44     my $test_file = "$Bin/testwide-passthrough.pl.src";
  45     test_file2file($test_file);
  46     test_scalar2scalar($test_file);
  47     test_scalararray2scalararray($test_file);
  48 }
  49
  50 sub test_file2file {
  51     my $test_file = shift;
  52
  53     my $tmp_file = File::Temp->new( TMPDIR => 1 );
  54
  55     my $source      = $test_file;
  56     my $destination = $tmp_file->filename();
  57
  58     my_note("Testing file2file: '$source' => '$destination'\n");
  59
  60     my $tidyresult = Perl::Tidy::perltidy(
  61         argv        => '-utf8 -npro',
  62         source      => $source,
  63         destination => $destination
  64     );
  65     ok( !$tidyresult, 'perltidy' );
  66
  67     my $source_str      = slurp_raw($source);
  68     my $destination_str = slurp_raw($destination);
  69
  70     my $source_hex      = unpack( 'H*', $source_str );
  71     my $destination_hex = unpack( 'H*', $destination_str );
  72     my_note("Comparing contents:\n  $source_hex\n  $destination_hex\n");
  73
  74     ok( $source_hex eq $destination_hex, 'file content compare' );
  75 }
  76
  77 sub test_scalar2scalar {
  78     my $testfile = shift;
  79
  80     my $source = slurp_raw($testfile);
  81     my $destination;
  82
  83     my_note("Testing scalar2scalar\n");
  84
  85     my $tidyresult = Perl::Tidy::perltidy(
  86         argv        => '-utf8 -eos -npro',
  87         source      => \$source,
  88         destination => \$destination
  89     );
  90     ok( !$tidyresult, 'perltidy' );
  91
  92     my $source_hex      = unpack( 'H*', $source );
  93     my $destination_hex = unpack( 'H*', $destination );
  94
  95     my_note("Comparing contents:\n  $source_hex\n  $destination_hex\n");
  96     ok( $source_hex eq $destination_hex, 'scalar content compare' );
  97 }
  98
  99 sub test_scalararray2scalararray {
 100     my $testfile = shift;
 101
 102     my $source      = [ lines_raw($testfile) ];
 103     my $destination = [];
 104
 105     my_note("Testing scalararray2scalararray\n");
 106
 107     my $tidyresult = Perl::Tidy::perltidy(
 108         argv        => '-utf8 -eos -npro',
 109         source      => $source,
 110         destination => $destination
 111     );
 112     ok( !$tidyresult, 'perltidy' );
 113
 114     my $source_str      = join( "", @$source );
 115     my $destination_str = join( "", @$destination );
 116
 117     my $source_hex      = unpack( 'H*', $source_str );
 118     my $destination_hex = unpack( 'H*', $destination_str );
 119
 120     my_note("Comparing contents:\n  $source_hex\n  $destination_hex\n");
 121     ok( $source_hex eq $destination_hex, 'scalararray content compare' );
 122 }
 123
 124 sub slurp_raw {
 125     my $filename = shift;
 126
 127     open( TMP, '<', $filename );
 128     binmode( TMP, ':raw' );
 129     local $/;
 130     my $contents = <TMP>;
 131     close(TMP);
 132
 133     return $contents;
 134 }
 135
 136 sub lines_raw {
 137     my $filename = shift;
 138
 139     open( TMP, '<', $filename );
 140     binmode( TMP, ':raw' );
 141     my @contents = <TMP>;
 142     close(TMP);
 143
 144     return @contents;
 145 }