X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=792e145961edfc1c2920cfe5f69bec2a8a9d523c;hp=429e17d345a24a9ca1d09bdd55ea5dc8dcc7b755;hb=2da706781c3db5e34375a6c3c0b8f72135b70c55;hpb=ea212c7ae3fabab519aefe16cbc24a8911be134f

diff --git a/git-debrebase b/git-debrebase
index 429e17d3..792e1459 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -228,7 +228,7 @@ sub get_differs ($$) {
 	    unless $differs & (D_PAT_ADD|D_PAT_OTH);
     }
 
-    printdebug sprintf "get_differs %s, %s = %#x\n", $x, $y, $differs;
+    printdebug sprintf "get_differs %s %s = %#x\n", $x, $y, $differs;
 
     return $differs;
 }
@@ -263,11 +263,15 @@ sub read_tree_debian ($) {
     rm_subdir_cached 'debian/patches';
 }
 
-sub read_tree_upstream ($;$) {
-    my ($treeish, $keep_patches) = @_;
-    my $save = cmdoutput @git, qw(write-tree --prefix=debian/);
+sub read_tree_upstream ($;$$) {
+    my ($treeish, $keep_patches, $tree_with_debian) = @_;
+    # if $tree_with_debian is supplied, will use that for debian/
+    # otherwise will save and restore it.
+    my $debian =
+	$tree_with_debian ? "$tree_with_debian:debian"
+	: cmdoutput @git, qw(write-tree --prefix=debian/);
     runcmd @git, qw(read-tree), $treeish;
-    read_tree_subdir 'debian', $save;
+    read_tree_subdir 'debian', $debian;
     rm_subdir_cached 'debian/patches' unless $keep_patches;
 };
 
@@ -344,11 +348,11 @@ sub gbp_pq_export ($$$) {
 }
 
 
-# xxx allow merge separately from laundering
+# xxx allow merge resolution separately from laundering, before git merge
 #
-# xxx docs highlight forbidden things
-# xxx docs list allowable things ?
-# xxx docs explicitly forbid some rebase
+# xxx general gdr docs highlight forbidden things
+# xxx general gdr docs list allowable things ?
+# xxx general gdr docs explicitly forbid some rebase
 #
 # xxx provide a way for the user to help
 # xxx (eg, provide wreckage provide way to continue)
@@ -358,8 +362,8 @@ sub gbp_pq_export ($$$) {
 #  our own patch identification algorithm?
 #  this is an alternative strategy
 
-sub merge_series ($$;@) {
-    my ($newbase, $base_q, @input_qs) = @_;
+sub merge_series ($$$;@) {
+    my ($newbase, $wrecknotes, $base_q, @input_qs) = @_;
     # $base_q{SeriesBase}  $input_qs[]{SeriesBase}
     # $base_q{SeriesTip}   $input_qs[]{SeriesTip}
     # ^ specifies several patch series (currently we only support exactly 2)
@@ -391,10 +395,11 @@ sub merge_series ($$;@) {
 	foreach my $q ($base_q, reverse @input_qs) {
 	    my $s = $q->{MR}{S};
 	    gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
+	    my @earlier;
 	    if (open S, $seriesfile) {
-		my @earlier;
 		while (my $patch = <S>) {
 		    chomp $patch or die $!;
+		    $prereq{$patch} //= {};
 		    foreach my $earlier (@earlier) {
 			$prereq{$patch}{$earlier}{$s}++ and die;
 		    }
@@ -419,6 +424,20 @@ sub merge_series ($$;@) {
                 "[git-debrebase merge-innards patch-queue prep:".
                 " $q->{SeriesTip}]"
             ];
+
+	    read_tree_debian $newbase;
+	    if (@earlier) {
+		read_tree_subdir 'debian/patches', "$pec:debian/patches";
+	    } else {
+		rm_subdir_cached 'debian/patches';
+	    }
+	    $pec = make_commit [ $pec ], [
+ "Update debian/ (excluding patches) to final to avoid re-merging",
+ "debian/ was already merged and we need to just take that.",
+                "[git-debrebase merge-innards patch-queue packaging:".
+                " $q->{SeriesTip}]"
+            ];
+
 	    printdebug "pec' $pec\n";
             runcmd @git, qw(reset -q --hard), $pec;
 	    $q->{MR}{PEC} = $pec;
@@ -503,7 +522,7 @@ sub merge_series ($$;@) {
 	}
 
 	runcmd @git, qw(add), $seriesfile;
-	runcmd @git, qw(commit --quiet -m), 'Merged series';
+	runcmd @git, qw(commit --quiet -m), 'Merged patch queue form';
 
 	printdebug "merge_series series gbp pq import\n";
 	runcmd qw(gbp pq import);
@@ -517,7 +536,7 @@ sub merge_series ($$;@) {
 	foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) {
 	    my $commit = git_cat_file $c, 'commit';
 	    printdebug "merge_series series ok, building $c\n";
-	    read_tree_upstream $c;
+	    read_tree_upstream $c, 0, $newbase;
 	    my $tree = cmdoutput @git, qw(write-tree);
 	    $commit =~ s{^parent (\S+)$}{parent $build}m or confess;
 	    $commit =~ s{^tree (\S+)$}{tree $tree}m      or confess;
@@ -528,6 +547,13 @@ sub merge_series ($$;@) {
 	}
 	$result = $build;
 	runcmd @git, qw(update-ref refs/heads/result), $result;
+
+	runcmd @git, qw(checkout -q -b debug);
+	runcmd @git, qw(commit --allow-empty -q -m M-INDEX);
+	runcmd @git, qw(add .);
+	runcmd @git, qw(commit --allow-empty -q -m M-WORKTREE);
+	my $mdebug = git_rev_parse 'HEAD';
+	printdebug sprintf "merge_series done debug=%s\n", $mdebug;
     };
     printdebug "merge_series returns $result\n";
     return $result;
@@ -809,8 +835,25 @@ sub classify ($) {
     return $classify->("VanillaMerge");
 }
 
-sub keycommits ($;$$$$) {
-    my ($head, $furniture, $unclean, $trouble, $fatal) = @_;
+sub keycommits ($;$$$$$);
+
+sub mergedbreakwaters_anchor ($) {
+    my ($cl) = @_;
+    my $best_anchor;
+    foreach my $p (@{ $cl->{Parents} }) {
+	my ($panchor, $pbw) = keycommits $p->{CommitId},
+	    undef,undef,undef,undef, 1;
+	$best_anchor = $panchor
+	    if !defined $best_anchor
+	    or is_fast_fwd $best_anchor, $panchor;
+	fail "inconsistent anchors in merged-breakwaters $p->{CommitId}"
+	    unless is_fast_fwd $panchor, $best_anchor;
+    }
+    return $best_anchor;
+}
+
+sub keycommits ($;$$$$$) {
+    my ($head, $furniture, $unclean, $trouble, $fatal, $claimed_bw) = @_;
     # => ($anchor, $breakwater)
 
     # $unclean->("unclean-$tagsfx", $msg, $cl)
@@ -826,6 +869,8 @@ sub keycommits ($;$$$$) {
     # $fatal is for unprocessable commits, and should normally cause
     #    a failure.  If ignored, agaion, (undef, undef) is returned.
     #
+    # If $claimed_bw, this is supposed to be a breakwater commit.
+    #
     # If a callback is undef, fail is called instead.
     # If a callback is defined but false, the situation is ignored.
     # Callbacks may say:
@@ -833,6 +878,7 @@ sub keycommits ($;$$$$) {
     # if the answer is no longer wanted.
 
     my ($anchor, $breakwater);
+    $breakwater = $head if $claimed_bw;
     my $clogonly;
     my $cl;
     my $found_pm;
@@ -845,6 +891,13 @@ sub keycommits ($;$$$$) {
 	return unless $cb;
 	$cb->("unclean-$tagsfx", $why, $cl, $mainwhy);
     };
+    my $found_anchor = sub {
+	($anchor) = @_;
+	$breakwater //= $clogonly;
+	$breakwater //= $head;
+	no warnings qw(exiting);
+	last;
+    };
     for (;;) {
 	$cl = classify $head;
 	my $ty = $cl->{Type};
@@ -858,10 +911,7 @@ sub keycommits ($;$$$$) {
 	} elsif ($ty eq 'Anchor' or
 		 $ty eq 'TreatAsAnchor' or
 		 $ty eq 'BreakwaterStart') {
-	    $anchor = $head;
-	    $breakwater //= $clogonly;
-	    $breakwater //= $head;
-	    last;
+	    $found_anchor->($head);
 	} elsif ($ty eq 'Upstream') {
 	    $x->($unclean, 'ordering',
  "packaging change ($breakwater) follows upstream change"," (eg $head)")
@@ -893,6 +943,8 @@ sub keycommits ($;$$$$) {
 	    $x->($trouble, 'vanillamerge',
 		 "found vanilla merge"," ($head)");
 	    return (undef,undef);
+	} elsif ($ty eq 'MergedBreakwaters') {
+	    $found_anchor->(mergedbreakwaters_anchor $cl);
 	} else {
 	    $x->($fatal, 'unprocessable',
 		 "found unprocessable commit, cannot cope: $cl->{Why}",
@@ -977,6 +1029,11 @@ sub walk ($;$$$) {
 	fail "something useful about failed merge attempt @_ xxx".Dumper($cl);
     };
 
+    my $mwrecknote = sub {
+	my ($reftail, $commitish) = @_;
+	$cl->{MergeWreckNotes}{$reftail} = $commitish;
+    };
+
     my $last_anchor;
 
     for (;;) {
@@ -1080,9 +1137,21 @@ sub walk ($;$$$) {
 		return $bomb->();
 	    }
 	    die "$ty ?";
-	} elsif ($ty eq 'VanillaMerge' or $ty eq 'MergedBreakwaters') {
-	    # xxx need to handle ffq if one side was unstitched
-	    # wait both of them may be!
+	} elsif ($ty eq 'MergedBreakwaters') {
+	    $last_anchor = mergedbreakwaters_anchor $cl;
+	    $build_start->(' MergedBreakwaters', $cur);
+	    last;
+	} elsif ($ty eq 'VanillaMerge') {
+	    # User may have merged unstitched branch(es).  We will
+	    # have now lost what ffq-prev was then (since the later
+	    # pseudomerge may introduce further changes).  The effect
+	    # of resolving such a merge is that we may have to go back
+	    # further in history to find a merge base, since the one
+	    # which was reachable via ffq-prev is no longer findable.
+	    # This is suboptimal, but if it all works we'll have done
+	    # the right thing.
+	    # xxx we should warn the user in the docs about this
+
 	    my $ok=1;
 	    my $best_anchor;
 	    # We expect to find a dominating anchor amongst the
@@ -1108,15 +1177,14 @@ sub walk ($;$$$) {
 
 	    printdebug "*** MERGE\n";
 
-	    # xxx avoid calling walk without nogenerate when
-	    # we have a MergedBreakwater; instead call keycommits ?
-
 	    my @bwbcmd = (@git, qw(merge-base));
 	    my @ibcmd = (@git, qw(merge-base --all));
 	    my $might_be_in_bw = 1;
 
 	    my $ps = $cl->{Parents};
 
+	    $mwrecknote->('vanilla-merge', $cl->{CommitId});
+
 	    foreach my $p (@$ps) {
 		$prline->(" VanillaMerge ".$p->{Ix});
 		$prprdelim->();
@@ -1127,6 +1195,17 @@ sub walk ($;$$$) {
 		$p->{Breakwater} = $p->{SeriesBase} = $pbw;
 		$p->{Anchor} = $panchor;
 
+		my $lr = $p->{LeftRight} = (qw(left right))[$p->{Ix}];
+		$mwrecknote->("$lr-input", $p->{CommitId});
+
+		my $mwrecknote_parent = sub {
+		    my ($which) = @_;
+		    $mwrecknote->("$lr-".(lc $which), $p->{$which});
+		};
+		$mwrecknote_parent->('Laundered');
+		$mwrecknote_parent->('Breakwater');
+		$mwrecknote_parent->('Anchor');
+
 		$best_anchor = $panchor if
 		    !defined $best_anchor or
 		    is_fast_fwd $best_anchor, $panchor;
@@ -1135,10 +1214,12 @@ sub walk ($;$$$) {
 		    " p=$panchor\n";
 	    }
 
+	    $mwrecknote->('result-anchor', $best_anchor);
+
 	    foreach my $p (@$ps) {
 		$prline->(" VanillaMerge ".$p->{Ix});
 		if (!is_fast_fwd $p->{Anchor}, $best_anchor) {
-		    $nomerge->('DivergentAnchor');
+		    $nomerge->('divergent anchors');
 		} elsif ($p->{Anchor} eq $best_anchor) {
 		    print $report " SameAnchor" if $report;
 		} else {
@@ -1156,14 +1237,14 @@ sub walk ($;$$$) {
 	    }
 
 	    if ($ok && $might_be_in_bw) {
+		# We could rewrite this to contaion the metadata
+		# declaring it to be MergedBreakwaters, but
+		# unnecessarily rewriting a merge seems unhelpful.
 		$prline->(" VanillaMerge MergedBreakwaters");
 		$last_anchor = $best_anchor;
 		$build_start->('MergedBreakwaters', $cur);
 	    }
 
-	    $nomerge->("alleged merged-breakwater is not a breakwater")
-		unless $ty eq 'VanillaMerge';
-
 	    my $bwb = cmdoutput @bwbcmd;
 
 	    # OK, now we have a breakwater base, but we need the merge
@@ -1174,17 +1255,39 @@ sub walk ($;$$$) {
 	    # breakwater merge base as an ancestor.
 
 	    my @ibs =
-		grep { is_fast_fwd $bwb, $_ }
 		grep /./,
 		split /\n/,
 		cmdoutput @ibcmd;
-	    my ($ib) = @ibs
-		or $nomerge->("no suitable interchange merge base");
+
+            @ibs or confess 'internal error, expected anchor at least ?';
+
+	    my $ib;
+	    my $ibleaf;
+	    foreach my $tibix (0..$#ibs) {
+		my $tib = $ibs[$tibix];
+		my $ff = is_fast_fwd $bwb, $tib;
+		my $ok = !$ff ? 'rej' : $ib ? 'extra' : 'ok';
+		my $tibleaf = "interchange-mbcand-$ok-$tibix";
+		$mwrecknote->($tibleaf, $tib);
+		next unless $ff;
+		next if $ib;
+		$ib = $tib;
+		$ibleaf = $tibleaf;
+	    }
+
+	    $ib or $nomerge->("no suitable interchange merge base");
 
 	    $prline->("  VanillaMerge Base");
 	    $prprdelim->();
-	    my ($btip, $bbw, $banchor) =
+	    my ($btip, $bbw, $banchor) = eval {
 		walk $ib, 0, $report, $report_lprefix.'  ';
+	    };
+	    $nomerge->("walking interchange branch merge base ($ibleaf): ".
+		       $@) if length $@;
+
+	    $mwrecknote->("mergebase-laundered", $btip);
+	    $mwrecknote->("mergebase-breakwater", $bbw);
+	    $mwrecknote->("mergebase-anchor", $banchor);
 
 	    my $ibinfo = { SeriesTip => $btip,
 			   SeriesBase => $bbw,
@@ -1193,6 +1296,7 @@ sub walk ($;$$$) {
 		or $nomerge->("interchange merge-base ($ib)'s".
 			      " breakwater ($bbw)".
 			      " != breakwaters' merge-base ($bwb)");
+
 	    grep { $_->{Anchor} eq $ibinfo->{Anchor} } @$ps
 		 or $nomerge->("interchange merge-base ($ib)'s".
 			       " anchor ($ibinfo->{SeriesBase})".
@@ -1200,13 +1304,13 @@ sub walk ($;$$$) {
 			       (join ' ', map { $_->{Anchor} } @$ps).
 			       ")");
 
-
 	    $cl->{MergeInterchangeBaseInfo} = $ibinfo;
 	    $cl->{MergeBestAnchor} = $best_anchor;
 	    push @brw_cl, {
                 %$cl,
                 SpecialMethod => 'MergeCreateMergedBreakwaters',
-                $xmsg->('construct merged breakwater from vanilla merge'),
+                $xmsg->('constructed from vanilla merge',
+			' merged-breakwater'),
             };
 	    push @upp_cl, {
                 %$cl,
@@ -1231,6 +1335,11 @@ sub walk ($;$$$) {
 
     my $rewriting = 0;
 
+    my $read_tree_upstream = sub {
+	my ($treeish) = @_;
+	read_tree_upstream $treeish, 0, $build;
+    };
+
     $#upp_cl = $upp_limit if defined $upp_limit;
  
     my $committer_authline = calculate_committer_authline();
@@ -1258,7 +1367,7 @@ sub walk ($;$$$) {
 	    if ($method eq 'Debian') {
 		read_tree_debian($cltree);
 	    } elsif ($method eq 'Upstream') {
-		read_tree_upstream($cltree);
+		$read_tree_upstream->($cltree);
 	    } elsif ($method eq 'StartRewrite') {
 		$rewriting = 1;
 		next;
@@ -1271,23 +1380,45 @@ sub walk ($;$$$) {
  		confess unless $rewriting;
 		my $differs = (get_differs $build, $cltree);
 		next unless $differs & D_UPS;
-		read_tree_upstream($cltree);
+		$read_tree_upstream->($cltree);
 		push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} };
 	    } elsif ($method eq 'MergeCreateMergedBreakwaters') {
 		print "Found a general merge, will try to tidy it up.\n";
 		$rewriting = 1;
-		read_tree_upstream($cl->{MergeBestAnchor});
-		read_tree_upstream($cl->{MergeBestAnchor});
+		$read_tree_upstream->($cl->{MergeBestAnchor});
+		$read_tree_upstream->($cl->{MergeBestAnchor});
 		read_tree_debian($cltree);
 		@parents = map { $_->{Breakwater} } @{ $cl->{Parents} };
 	    } elsif ($method eq 'MergeMergeSeries') {
 		print "Running merge resolution for $cl->{CommitId}...\n";
 		$build = merge_series
-		    $build,
+		    $build, $cl->{MergeWreckNotes},
 		    $cl->{MergeInterchangeBaseInfo},
 		    @{ $cl->{Parents} };
 		$last_anchor = $cl->{MergeBestAnchor};
-		# xxx need to check the tree somehow
+
+		# Check for mismerges:
+		my $check = sub {
+		    my ($against, $allow, $what) = @_;
+		    my $differs = get_differs $build, $against;
+		    $nomerge->(sprintf
+       "merge misresolved: %s are not the same (%s %s d.%#x)",
+			       $what, $against, $build, $differs)
+			if $differs & ~($allow | D_PAT_ADD);
+		};
+
+		# Breakwater changes which were in each side of the
+		# merge will have been incorporated into the
+		# MergeCreateMergedBreakwaters output.  Because the
+		# upstream series was rebased onto the new breakwater,
+		# so should all of the packaging changes which were in
+		# the input.
+		$check->($input, D_UPS, 'debian files');
+
+		# Upstream files are merge_series, which ought to
+		# have been identical to the original merge.
+		$check->($cl->{CommitId}, DS_DEB, 'upstream files');
+
 		print "Merge resolution successful.\n";
 		next;
 	    } else {