remove the unused compare sub
authorGabor Szabo <gabor@szabgab.com>
Tue, 29 Nov 2011 15:24:20 +0000 (17:24 +0200)
committerGabor Szabo <gabor@szabgab.com>
Tue, 29 Nov 2011 15:24:20 +0000 (17:24 +0200)
t/test.pm

index 1a74229..49ed95a 100644 (file)
--- a/t/test.pm
+++ b/t/test.pm
@@ -82,8 +82,6 @@ The following symbols are exported upon request:
 
 =over 4
 
-=item compare
-
 =item evcheck
 
 =item save_output
@@ -162,9 +160,6 @@ sub find_exec {
 
 $PATH = join ':', BUILD_SCRIPT_DIR, split /:/, $PATH;
 
-$_ = rel2abs($_)
-  for @INC;
-
 my $tmpdn = tempdir();
 $| = 1;
 
@@ -172,7 +167,6 @@ mkpath $tmpdn;
 die "Couldn't create temp dir: $tmpdn: $!\n"
   unless -r $tmpdn and -w $tmpdn and -x $tmpdn and -o $tmpdn and -d $tmpdn;
 
-#@INC = map rel2abs($_), @INC;
 chdir $tmpdn;
 
 # -------------------------------------
@@ -494,309 +488,6 @@ END {
 
 # -------------------------------------
 
-=head2 compare
-
-  compare(+{ fn1 => $fn1, fn2 => $fn2, gzip => 1 });
-
-This performs one test.
-
-=over 4
-
-=item ARGUMENTS
-
-A single argument is taken, considered as a hash ref, with the following keys:
-
-In TEST_DEBUG mode, if the files do not compare equal, outputs file info on
-STDERR.
-
-=over 4
-
-=item fn1
-
-B<Mandatory>  File to compare
-
-=item fn2
-
-B<Mandatory>  File to compare
-
-=item name
-
-B<Mandatory>  Test name
-
-=item sort
-
-B<Optional> sort files prior to comparison.  Requires the C<sort> command to
-be on C<$PATH> (else skips).
-
-=item gunzip
-
-B<Optional> gunzip files prior to comparison.  Requires the C<gzip> command to
-be on C<$PATH> (else skips).  gzip occurs prior to any sort.
-
-=item untar
-
-B<Optional> untar files prior to comparison.  Requires the C<tar> command to
-be on C<$PATH> (else skips).  any gzip occurs prior to any tar.  Tar files are
-considered equal if they each contain the same filenames & each file contained
-is equal.  If the sort flag is present, each file is sorted prior to comparison.
-
-=back
-
-=back
-
-=cut
-
-# return codes and old-style call semantics left for backwards compatibility
-BEGIN {
-  my $savewarn = $SIG{__WARN__};
-  # Subvert bizarre (& incorrect) subroutine redefined errors in 5.005_03
-  local $SIG{__WARN__} =
-    sub {
-      $savewarn->(@_)
-        if defined $savewarn                        and
-           UNIVERSAL::isa($savewarn,'CODE')         and
-           $_[0] !~ /^Subroutine compare redefined/;
-    };
-
-  *compare = sub {
-    my ($fn1, $fn2, $sort) = @_;
-    my ($gzip, $tar, $name);
-    my $notest = 1;
-
-    if ( @_ == 1 and UNIVERSAL::isa($_[0], 'HASH') ) {
-      ($fn1, $fn2, $name, $sort, $gzip, $tar, $notest) =
-        @{$_[0]}{qw( fn1 fn2 name sort gunzip untar notest )};
-      my @missing = grep ! defined $_[0]->{$_}, qw( fn1 fn2 name );
-      carp "Missing mandatory key(s): " . join(', ', @missing) . "\n"
-        if @missing;
-    }
-
-    my ($name1, $name2) = ($fn1, $fn2);
-
-    for ( grep ! defined, $fn1, $fn2 ) {
-      carp 'Usage: compare({fn1 => $fn1, fn2 => $fn2, name => "some name"})' ."\n"
-          if $ENV{TEST_DEBUG};
-      ok 0, 1, $name
-        unless $notest;
-      return -8;
-    }
-
-    {
-      my $err = 0;
-
-      for (0..1) {
-        my $fn = ($name1, $name2)[$_];
-        if ( ! -e $fn ) {
-          carp "Does not exist: $fn\n"
-            if $ENV{TEST_DEBUG};
-          $err |= 2 ** $_;
-        } elsif ( ! -r $fn ) {
-          carp "Cannot read: $fn\n"
-            if $ENV{TEST_DEBUG};
-          $err |= 2 ** $_;
-        }
-      }
-
-      if ( $err ) {
-        ok 0, 1, $name
-          unless $notest;
-        return -$err;
-      }
-    }
-
-    if ( $gzip ) {
-      unless ( find_exec('gzip') ) {
-        print "ok # Skip gzip not found in path\n";
-        return -16;
-      }
-
-      my $tmp1 = tmpnam;
-      my $tmp2 = tmpnam;
-      system "gzip $fn1 -cd > $tmp1"
-        and croak "gzip $fn1 failed: $?\n";
-      system "gzip $fn2 -cd > $tmp2"
-        and croak "gzip $fn2 failed: $?\n";
-      ($fn1, $fn2) = ($tmp1, $tmp2);
-    }
-
-    if ( $tar ) {
-      unless ( find_exec('tar') ) {
-        print "ok # Skip tar not found in path\n";
-        return -16;
-      }
-
-      local $/ = "\n";
-      chomp (my @list1 = sort qx( tar tf $fn1 ));
-      croak "tar tf $fn1 failed with wait status: $?\n"
-        if $?;
-      chomp(my @list2 = sort qx( tar tf $fn2 ));
-      croak "tar tf $fn2 failed with wait status: $?\n"
-        if $?;
-
-      if ( @list2 > @list1 ) {
-        carp
-          sprintf("More files (%d) in $name2 than $name1 (%d)\n",
-                  scalar @list2, scalar @list1)
-          if $ENV{TEST_DEBUG};
-        ok @list1, @list2, $name
-          unless $notest;
-        return 0;
-      } elsif ( @list1 > @list2 ) {
-        carp
-          sprintf("More files (%d) in $name1 than $name2 (%d)\n",
-                  scalar @list1, scalar @list2)
-          if $ENV{TEST_DEBUG};
-        ok @list1, @list2, $name
-          unless $notest;
-        return 0;
-      }
-
-      for (my $i = 0; $i < @list1; $i++) {
-        if ( $list1[$i] lt $list2[$i] ) {
-          carp "File $list1[$i] is present in $name1 but not $name2\n"
-            if $ENV{TEST_DEBUG};
-          ok $list1[$i], $list2[$i], $name
-            unless $notest;
-          return 0;
-        } elsif ( $list1[$i] gt $list2[$i] ) {
-          carp "File $list2[$i] is present in $name2 but not $name1\n"
-            if $ENV{TEST_DEBUG};
-          ok $list2[$i], $list1[$i], $name
-            unless $notest;
-          return 0;
-        }
-      }
-
-      for my $fn (@list1) {
-        my $tmp1 = tmpnam;
-        my $tmp2 = tmpnam;
-        system "tar -xf $fn1 -O $fn > $tmp1"
-          and croak "tar -xf $fn1 -O $fn failed: $?\n";
-        system "tar -xf $fn2 -O $fn > $tmp2"
-          and croak "tar -xf $fn2 -O $fn failed: $?\n";
-        my $ok = compare({ fn1    => $tmp1,
-                           fn2    => $tmp2,
-                           sort   => $sort,
-                           notest => 1,
-                           name   =>
-                             qq'Subcheck file "$fn" for compare $name1, $name2',
-                         });
-        unless ( $ok >= 1 ) {
-          carp qq'Difference found testing file "$fn" in tars $name1 ($tmp1), $name2 ($tmp2)\n'
-            if $ENV{TEST_DEBUG};
-          ok 0, 1, $name
-            unless $notest;
-          return 0;
-        }
-      }
-
-      ok 1, 1, $name
-        unless $notest;
-      return 1;
-    }
-
-    if ( $sort ) {
-      unless ( find_exec('sort') ) {
-        print "ok # Skip sort not found in path\n";
-        return -16;
-      }
-
-      my $tmp1 = tmpnam;
-      my $tmp2 = tmpnam;
-      system sort => $fn1, -o => $tmp1
-        and croak "Sort $fn1 failed: $?\n";
-      system sort => $fn2, -o => $tmp2
-        and croak "Sort $fn2 failed: $?\n";
-      ($fn1, $fn2) = ($tmp1, $tmp2);
-    }
-
-    unless ( File::Compare::compare($fn1, $fn2) ) {
-      ok 1, 1, $name
-        unless $notest;
-      return 1;
-    }
-
-    if ( $ENV{TEST_DEBUG} ) {
-      my $pid = fork;
-      die "Fork failed: $!\n"
-        unless defined $pid;
-
-      if ( $pid ) { # Parent
-        my $waitpid = waitpid($pid, 0);
-        die "Waitpid got: $waitpid (expected $pid)\n"
-          unless $waitpid == $pid;
-      } else { # Child
-        open *STDOUT{IO}, ">&" . fileno STDERR;
-        # Uniquify file names
-        my @args = keys %{+{ map {;$_=>1} $name1, $name2, $fn1, $fn2 }};
-        exec qw(ls -l), @args;
-      }
-
-      my $fh1 = IO::File->new($fn1, O_RDONLY)
-        or die "Couldn't open $fn1: $!\n";
-      my $fh2 = IO::File->new($fn2, O_RDONLY)
-        or die "Couldn't open $fn2: $!\n";
-
-      local $/ = "\n";
-
-      my $found = 0;
-      while ( ! $found and my $line1 = <$fh1> ) {
-        my $line2 = <$fh2>;
-        if ( ! defined $line2 ) {
-          print STDERR "$fn2 ended at line: $.\n";
-          $found = 1;
-        } elsif ( $line2 ne $line1 ) {
-          my $maxlength = max(map length($_), $line1, $line2);
-          my $minlength = min(map length($_), $line1, $line2);
-
-          my @diffchars = grep(substr($line1, $_, 1) ne substr($line2, $_, 1),
-                               0..$minlength-1);
-          my $diff = ' ' x $minlength;
-          substr($diff, $_, 1) = '|'
-            for @diffchars;
-
-          my @extrachars, map((length($line1) > length($line2) ? '^' : 'v'),
-                              $minlength..$maxlength-1);
-
-          $diff = join '', $diff, @extrachars;
-
-          my $diff_count  = @diffchars;
-          my $extra_count = @extrachars;
-
-          print STDERR <<"END";
-Difference at line $. ($diff_count characters differ) (top line is $extra_count chars longer):
-$name1:
--->$line1<--
-   $diff
--->$line2<--
-$name2:
-Differing characters at positions @{[join ',',@diffchars]} (zero-based)
-END
-          $found = 1;
-        }
-      }
-
-      if ( ! $found ) {
-        my $line2 = <$fh2>;
-        if ( defined $line2 ) {
-          print STDERR "$name1 ended before line: $.\n";
-        } else {
-          print STDERR "Difference between $name1, $name2 not found!\n";
-        }
-      }
-
-      close $fh1;
-      close $fh2;
-    }
-
-    ok 0, 1, $name
-      unless $notest;
-    return 0;
-  }
-}
-
-# -------------------------------------
-
 =head2 find_exec
 
 =over 4