[libgsf] Tests: refactor zip tests a bit.

[Morten Welinder <mortenw src gnome org>]

commit d05b4b08962063927eb4f098f091e618600a3668
Author: Morten Welinder <terra gnome org>
Date:   Mon Dec 1 19:35:44 2014 -0500

    Tests: refactor zip tests a bit.
    
    We'll need the same thing for ole2 and tar.

 NEWS                        |    1 +
 tests/LibGsfTest.pm         |  147 ++++++++++++++++++++++++++++++++++++-------
 tests/t1000-zip-single.pl   |    3 +-
 tests/t1001-zip-multiple.pl |    3 +-
 tests/t1002-zip-aaaa.pl     |    3 +-
 tests/t1003-zip-noise.pl    |    5 +-
 6 files changed, 133 insertions(+), 29 deletions(-)
---
diff --git a/NEWS b/NEWS
index 389a601..49db157 100644
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,7 @@ Morten:
        * Store unix modtime in zip.  (Until that overflows.)
        * Fix seekability checks in GsfOutputIOChannel.
        * Avoid implementation defined behaviour of shifts.
+       * Start a test suite.
 
 --------------------------------------------------------------------------
 libgsf 1.14.30
diff --git a/tests/LibGsfTest.pm b/tests/LibGsfTest.pm
index 4d56998..103e06d 100644
--- a/tests/LibGsfTest.pm
+++ b/tests/LibGsfTest.pm
@@ -252,48 +252,147 @@ sub quotearg1 {
 
 # -----------------------------------------------------------------------------
 
+sub zipinfo_callback {
+    my ($archive) = @_;
+
+    my @result = ();
+
+    my $entry = undef;
+    foreach (`$zipinfo -v $archive`) {
+       print STDERR "| $_" if $verbose;
+
+       if (/^Central directory entry #\d+:$/) {
+           push @result, $entry if defined $entry;
+           $entry = {};
+           next;
+       }
+
+       if ($entry && /^\s*- A subfield with ID 0x0001 \(PKWARE 64-bit sizes\)/) {
+           $entry->{'zip64'} = 1;
+           next;
+       }
+
+       if ($entry && /^  *(\S.*\S):\s*(\S.*)$/) {
+           my $field = $1;
+           my $val = $2;
+           $val =~ s/ (bytes|characters)$//;
+           $entry->{$field} = $val;
+           next;
+       }
+
+       if ($entry && keys %$entry == 0 && /^  (.*)$/) {
+           $entry->{'name'} = $1;
+           next;
+       }
+    }
+    push @result, $entry if defined $entry;
+
+    return (undef,\ result);
+}
+
 sub test_zip {
     my (%args) = @_;
 
-    my $pfiles = $args{'files'};
+    $args{'createarg'} = 'createzip';
+    $args{'ext'} = 'zip';
+    $args{'archive-tester'} = [$unzip, '-q', '-t'];
+    $args{'independent-cat'} = [$unzip, '-p'];
+    $args{'infofunc'} = \&zipinfo_callback;
+
+    foreach my $test (@{$args{'zip-member-tests'} || []}) {
+       $args{'member-tests'} ||= [];
+
+       if ($test eq 'zip64') {
+           push @{$args{'member-tests'}},
+           sub {
+               my ($member) = @_;
+               my $name = $member->{'name'};
+               die "Member $name should have been zip64\n" unless $member->{'zip64'};
+           };
+           next;
+       }
+
+       if ($test eq '!zip64') {
+           push @{$args{'member-tests'}},
+           sub {
+               my ($member) = @_;
+               my $name = $member->{'name'};
+               die "Member $name should not be zip64\n" if $member->{'zip64'};
+           };
+           next;
+       }
+    }
+
+    &test_archive (\%args);
+}
 
-    my $archive = 'test.zip';
+# -----------------------------------------------------------------------------
+
+sub test_archive {
+    my ($pargs) = @_;
+
+    my $pfiles = $pargs->{'files'};
+    my $ext = $pargs->{'ext'};
+    my $tester = $pargs->{'archive-tester'};
+    my $independent_cat = $pargs->{'independent-cat'};
+    my $member_tests = $pargs->{'member-tests'};
+    my $infofunc = $pargs->{'infofunc'};
+
+    my $archive = "test.$ext";
     &junkfile ($archive);
 
     {
-       my $cmd = &quotearg ($gsf, "createzip", $archive, @$pfiles);
-       print "# $cmd\n";
+       my $gsfcmd = $pargs->{'createarg'};
+       my $cmd = &quotearg ($gsf, $gsfcmd, $archive, @$pfiles);
+       print STDERR "# $cmd\n";
        my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
        &system_failure ($gsf, $code) if $code;
        die "$gsf failed to create the archive $archive\n" unless -e $archive;
     }
 
-    {
-       my $cmd = &quotearg ($unzip, '-q', '-t', $archive);
-       print "# $cmd\n";
-       my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
-       &system_failure ($unzip, $code) if $code;
-    }
-
-    if ($verbose) {
-       my $cmd = &quotearg ($zipinfo, '-v', $archive);
-       print "# $cmd\n";
+    if ($tester) {
+       my $cmd = &quotearg (@$tester, $archive);
+       print STDERR "# $cmd\n";
        my $code = system ("$cmd 2>&1 | sed -e 's/^/| /'");
-       &system_failure ($zipinfo, $code) if $code;
+       &system_failure ($tester->[0], $code) if $code;
     }
 
     foreach my $file (@$pfiles) {
-       my $cmd = &quotearg ('unzip', '-p', $archive, $file);
-       print "# $cmd\n";
-       my $stored_data = `$cmd`;
-
-       $cmd = &quotearg ('cat', $file);
-       print "# $cmd\n";
+       my $cmd = &quotearg ('cat', $file);
+       print STDERR "# $cmd\n";
        my $original_data = `$cmd`;
 
-       die "Mismatch for member $file\n"
-           unless $stored_data eq $original_data;
-       print "# Member $file matched.\n";
+       # Match stored data using external extractor if we have one
+       if ($independent_cat) {
+           my $cmd = &quotearg (@$independent_cat, $archive, $file);
+           print STDERR "# $cmd\n";
+           my $stored_data = `$cmd`;
+
+           die "Mismatch for member $file\n"
+               unless $stored_data eq $original_data;
+       }
+
+       # Match stored data using our own extractor
+       {
+           my $cmd = &quotearg ($gsf, 'cat', $archive, $file);
+           print STDERR "# $cmd\n";
+           my $stored_data = `$cmd`;
+
+           die "Mismatch for member $file\n"
+               unless $stored_data eq $original_data;
+       }
+
+       print STDERR "# Member $file matched.\n";
+    }
+
+    if ($infofunc) {
+       my ($ainfo,$minfo) = &$infofunc ($archive);
+
+       foreach my $test (@$member_tests) {
+           foreach my $member (@$minfo) {
+               &$test ($member);
+           }
+       }
     }
 }
 
diff --git a/tests/t1000-zip-single.pl b/tests/t1000-zip-single.pl
index c69c113..4dbe142 100755
--- a/tests/t1000-zip-single.pl
+++ b/tests/t1000-zip-single.pl
@@ -5,4 +5,5 @@ use strict;
 use lib ($0 =~ m|^(.*/)| ? $1 : ".");
 use LibGsfTest;
 
-&test_zip ('files' => ['Makefile.am']);
+&test_zip ('files' => ['Makefile.am'],
+          'zip-member-tests' => ['!zip64']);
diff --git a/tests/t1001-zip-multiple.pl b/tests/t1001-zip-multiple.pl
index 50ccfd3..469fb44 100755
--- a/tests/t1001-zip-multiple.pl
+++ b/tests/t1001-zip-multiple.pl
@@ -5,4 +5,5 @@ use strict;
 use lib ($0 =~ m|^(.*/)| ? $1 : ".");
 use LibGsfTest;
 
-&test_zip ('files' => ['Makefile.am', 'common.supp']);
+&test_zip ('files' => ['Makefile.am', 'common.supp'],
+          'zip-member-tests' => ['!zip64']);
diff --git a/tests/t1002-zip-aaaa.pl b/tests/t1002-zip-aaaa.pl
index dff15a6..4f516ea 100755
--- a/tests/t1002-zip-aaaa.pl
+++ b/tests/t1002-zip-aaaa.pl
@@ -14,4 +14,5 @@ my $aaaa = 'aaaa.txt';
     print $f "a"x10000000;
 }
 
-&test_zip ('files' => [$aaaa]);
+&test_zip ('files' => [$aaaa],
+          'zip-member-tests' => ['!zip64']);
diff --git a/tests/t1003-zip-noise.pl b/tests/t1003-zip-noise.pl
index c86102b..46b4a78 100755
--- a/tests/t1003-zip-noise.pl
+++ b/tests/t1003-zip-noise.pl
@@ -6,7 +6,8 @@ use lib ($0 =~ m|^(.*/)| ? $1 : ".");
 use LibGsfTest;
 use FileHandle;
 
-my $noise = 'noise.txt';
+my $noise = 'noise.bin';
 &LibGsfTest::junkfile ($noise);
 system ("dd", "if=/dev/urandom", "of=$noise", "bs=1M", "count=10");
-&test_zip ('files' => [$noise]);
+&test_zip ('files' => [$noise],
+          'zip-member-tests' => ['!zip64']);