tests/test-wrap-argv.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (C) 2015 Red Hat, Inc.
   4 #
   5 # This library is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU Lesser General Public
   7 # License as published by the Free Software Foundation; either
   8 # version 2.1 of the License, or (at your option) any later version.
   9 #
  10 # This library is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # Lesser General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU Lesser General Public
  16 # License along with this library.  If not, see
  17 # <http://www.gnu.org/licenses/>.
  18 #
  19 # This script is intended to be passed a list of .args files, used
  20 # to store command line ARGV for the test suites. It will reformat
  21 # them such that there is at most one '-param value' on each line
  22 # of the file. Parameter values that are longer than 80 chars will
  23 # also be split.
  24 #
  25 # If --in-place is supplied as the first parameter of this script,
  26 # the files will be changed in place.
  27 # If --check is the first parameter, the script will return
  28 # a non-zero value if a file is not wrapped correctly.
  29 # Otherwise the rewrapped files are printed to the standard output.
  30
  31 $in_place = 0;
  32 $check = 0;
  33
  34 if (@ARGV[0] eq "--in-place" or @ARGV[0] eq "-i") {
  35     $in_place = 1;
  36     shift @ARGV;
  37 } elsif (@ARGV[0] eq "--check") {
  38     $check = 1;
  39     shift @ARGV;
  40 }
  41
  42 $ret = 0;
  43 foreach my $file (@ARGV) {
  44     if (&rewrap($file) < 0) {
  45         $ret = 1;
  46     }
  47 }
  48
  49 exit $ret;
  50
  51 sub rewrap {
  52     my $file = shift;
  53
  54     # Read the original file
  55     open FILE, "<", $file or die "cannot read $file: $!";
  56     my @orig_lines = <FILE>;
  57     close FILE;
  58     my @lines = @orig_lines;
  59     foreach (@lines) {
  60         # If there is a trailing '\' then kill the new line
  61         if (/\\$/) {
  62             chomp;
  63             $_ =~ s/\\$//;
  64         }
  65     }
  66
  67     # Skip empty files
  68     return unless @lines;
  69
  70     # Kill the last new line in the file
  71     chomp @lines[$#lines];
  72
  73     # Reconstruct the master data by joining all lines
  74     # and then split again based on the real desired
  75     # newlines
  76     @lines = split /\n/, join('', @lines);
  77
  78     # Now each @lines represents a single command, we
  79     # can process them
  80     @lines = map { &rewrap_line($_) } @lines;
  81
  82     if ($in_place) {
  83         open FILE, ">", $file or die "cannot write $file: $!";
  84         foreach my $line (@lines) {
  85             print FILE $line;
  86         }
  87         close FILE;
  88     } elsif ($check) {
  89         my $nl = join('', @lines);
  90         my $ol = join('', @orig_lines);
  91         unless ($nl eq $ol) {
  92             open DIFF, "| diff -u $file -" or die "cannot run diff: $!";
  93             print DIFF $nl;
  94             close DIFF;
  95
  96             print STDERR "Incorrect line wrapping in $file\n";
  97             print STDERR "Use test-wrap-argv.pl to wrap test data files\n";
  98             return -1;
  99         }
 100     } else {
 101         foreach my $line (@lines) {
 102             print $line;
 103         }
 104     }
 105     return 0;
 106 }
 107
 108 sub rewrap_line {
 109     my $line = shift;
 110     my @bits = split / /, join('', $line);
 111
 112     # @bits contains env vars, then the command line
 113     # and then the arguments
 114     my @env;
 115     my $cmd;
 116     my @args;
 117
 118     if ($bits[0] !~ /=/) {
 119         $cmd = shift @bits;
 120     }
 121
 122     foreach my $bit (@bits) {
 123         # If no command is defined yet, we must still
 124         # have env vars
 125         if (!defined $cmd) {
 126             # Look for leading / to indicate command name
 127             if ($bit =~ m,^/,) {
 128                 $cmd = $bit;
 129             } else {
 130                 push @env, $bit;
 131             }
 132         } else {
 133             # If there's a leading '-' then this is a new
 134             # parameter, otherwise its a value for the prev
 135             # parameter.
 136             if ($bit =~ m,^-,) {
 137                 push @args, $bit;
 138             } else {
 139                 $args[$#args] .= " " . $bit;
 140             }
 141         }
 142     }
 143
 144     # We might have to split line argument values...
 145     @args = map { &rewrap_arg($_) } @args;
 146     # Print env + command first
 147     return join(" \\\n", @env, $cmd, @args), "\n";
 148 }
 149
 150 sub rewrap_arg {
 151     my $arg = shift;
 152     my @ret;
 153     my $max_len = 78;
 154
 155     while (length($arg) > $max_len) {
 156         my $split = rindex $arg, ",", $max_len;
 157         if ($split == -1) {
 158             $split = rindex $arg, ":", $max_len;
 159         }
 160         if ($split == -1) {
 161             $split = rindex $arg, " ", $max_len;
 162         }
 163         if ($split == -1) {
 164             warn "cannot find nice place to split '$arg' below 80 chars\n";
 165             $split = $max_len - 1;
 166         }
 167         $split++;
 168
 169         push @ret, substr $arg, 0, $split;
 170         $arg = substr $arg, $split;
 171     }
 172     push @ret, $arg;
 173     return join("\\\n", @ret);
 174 }