From fc498c99ddaa51b003d7b6f9b2f5533f62e8c71d Mon Sep 17 00:00:00 2001 From: Gabor Szabo Date: Tue, 29 Nov 2011 17:24:20 +0200 Subject: [PATCH] remove the unused compare sub --- t/test.pm | 309 ------------------------------------------------------ 1 file changed, 309 deletions(-) diff --git a/t/test.pm b/t/test.pm index 1a74229..49ed95a 100644 --- 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 File to compare - -=item fn2 - -B File to compare - -=item name - -B Test name - -=item sort - -B sort files prior to comparison. Requires the C command to -be on C<$PATH> (else skips). - -=item gunzip - -B gunzip files prior to comparison. Requires the C command to -be on C<$PATH> (else skips). gzip occurs prior to any sort. - -=item untar - -B untar files prior to comparison. Requires the C 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 -- 2.39.2