Test suite: mismatch: New test

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 50011cce1bde6c9ea94ce28dd0530a99db2b09f3..fa926dd0096d4db23a4a5af959030f6f4ccef7f2 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -1414,10 +1414,13 @@ sub mktree_in_ud_from_only_subdir (;$) {
     return ($tree,$dir);
 }
 
+our @files_csum_info_fields = 
+    (['Checksums-Sha256','Digest::SHA', 'new(256)'],
+     ['Checksums-Sha1',  'Digest::SHA', 'new(1)'],
+     ['Files',           'Digest::MD5', 'new()']);
+
 sub dsc_files_info () {
-    foreach my $csumi (['Checksums-Sha256','Digest::SHA', 'new(256)'],
-                      ['Checksums-Sha1',  'Digest::SHA', 'new(1)'],
-                      ['Files',           'Digest::MD5', 'new()']) {
+    foreach my $csumi (@files_csum_info_fields) {
        my ($fname, $module, $method) = @$csumi;
        my $field = $dsc->{$fname};
        next unless defined $field;
@@ -1445,6 +1448,65 @@ sub dsc_files () {
     map { $_->{Filename} } dsc_files_info();
 }
 
+sub files_compare_inputs (@) {
+    my $inputs = \@_;
+    my %record;
+    my %fchecked;
+
+    my $showinputs = sub {
+       return join "; ", map { $_->get_option('name') } @$inputs;
+    };
+
+    foreach my $in (@$inputs) {
+       my $expected_files;
+       my $in_name = $in->get_option('name');
+
+       printdebug "files_compare_inputs $in_name\n";
+
+       foreach my $csumi (@files_csum_info_fields) {
+           my ($fname) = @$csumi;
+           printdebug "files_compare_inputs $in_name $fname\n";
+
+           my $field = $in->{$fname};
+           next unless defined $field;
+
+           my @files;
+           foreach (split /\n/, $field) {
+               next unless m/\S/;
+
+               my ($info, $f) = m/^(\w+ \d+) (?:\S+ \S+ )?(\S+)$/ or
+                   fail "could not parse $in_name $fname line \`$_'";
+
+               printdebug "files_compare_inputs $in_name $fname $f\n";
+
+               push @files, $f;
+
+               my $re = \ $record{$f}{$fname};
+               if (defined $$re) {
+                   $fchecked{$f}{$in_name} = 1;
+                   $$re eq $info or
+                       fail "hash or size of $f varies in $fname fields".
+                       " (between: ".$showinputs->().")";
+               } else {
+                   $$re = $info;
+               }
+           }
+           @files = sort @files;
+           $expected_files //= \@files;
+           "@$expected_files" eq "@files" or
+               fail "file list in $in_name varies between hash fields!";
+       }
+       $expected_files or
+           fail "$in_name has no files list field(s)";
+    }
+    printdebug "files_compare_inputs ".Dumper(\%fchecked, \%record)
+       if $debuglevel>=2;
+
+    grep { keys %$_ == @$inputs-1 } values %fchecked
+       or fail "no file appears in all file lists".
+       " (looked in: ".$showinputs->().")";
+}
+
 sub is_orig_file_in_dsc ($$) {
     my ($f, $dsc_files_info) = @_;
     return 0 if @$dsc_files_info <= 1;
@@ -2136,6 +2198,8 @@ sub mergeinfo_version ($) {
 }
 
 sub fetch_from_archive () {
+    ensure_setup_existing_tree();
+
     # Ensures that lrref() is what is actually in the archive, one way
     # or another, according to us - ie this client's
     # appropritaely-updated archive view.  Also returns the commit id.
@@ -2535,6 +2599,13 @@ sub setup_useremail (;$) {
     $setup->('name', 'DEBFULLNAME');
 }
 
+sub ensure_setup_existing_tree () {
+    my $k = "remote.$remotename.skipdefaultupdate";
+    my $c = git_get_config $k;
+    return if defined $c;
+    set_local_git_config $k, 'true';
+}
+
 sub setup_new_tree () {
     setup_mergechangelogs();
     setup_useremail();
@@ -3154,6 +3225,10 @@ END
        $changesfile = "$buildproductsdir/$changesfile";
     }
 
+    # Check that changes and .dsc agree enough
+    $changesfile =~ m{[^/]*$};
+    files_compare_inputs($dsc, parsecontrol($changesfile,$&));
+
     # Checks complete, we're going to try and go ahead:
 
     responder_send_file('changes',$changesfile);
@@ -3221,7 +3296,8 @@ END
        push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
     }
 
-    runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs;
+    runcmd_ordryrun @git,
+       qw(-c push.followTags=false push), access_giturl(), @pushrefs;
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
 
     supplementary_message(<<'END');
@@ -4671,6 +4747,10 @@ sub cmd_build {
     printdone "build successful\n";
 }
 
+sub pre_gbp_build {
+    $quilt_mode //= 'gbp';
+}
+
 sub cmd_gbp_build {
     my @dbp = @dpkgbuildpackage;
 
@@ -5101,6 +5181,9 @@ if (!@ARGV) {
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
 
+my $pre_fn = ${*::}{"pre_$cmd"};
+$pre_fn->() if $pre_fn;
+
 if (!defined $rmchanges) {
     local $access_forpush;
     $rmchanges = access_cfg_bool(0, 'rm-old-changes');