X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=2a28e720b43d3712fb2910902375fb5113e6370b;hp=5049ca6d5948d94837a28e3d5cdf12b6d445c721;hb=bc8a67b8d44d166e125c946960cdfe567e2325dc;hpb=55b32c7177b49f38528dabff534a743c28339844 diff --git a/git-debrebase b/git-debrebase index 5049ca6d..2a28e720 100755 --- a/git-debrebase +++ b/git-debrebase @@ -36,6 +36,8 @@ use Dpkg::Version; use File::FnMatch qw(:fnmatch); use File::Copy; +$debugcmd_when_debuglevel = 2; + our ($usage_message) = <<'END'; usages: git-debrebase [] [--|-i ] @@ -49,10 +51,12 @@ See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit). END our ($opt_force, $opt_noop_ok, @opt_anchors); -our ($opt_defaultcmd_interactive); +our ($opt_defaultcmd_interactive, $opt_save_wreckage); our $us = qw(git-debrebase); +our $wrecknoteprefix = 'refs/debrebase-wreckage'; + $|=1; sub badusage ($) { @@ -129,12 +133,35 @@ sub fresh_workarea () { in_workarea sub { playtree_setup }; } +sub run_ref_updates_now ($$) { + my ($mrest, $updates) = @_; + # @$updates is a list of lines for git-update-ref, without \ns + + my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); + debugcmd '>|', @upd_cmd; + open U, "|-", @upd_cmd or die $!; + foreach (@$updates) { + printdebug ">= ", $_, "\n"; + print U $_, "\n" or die $!; + } + printdebug ">\$\n"; + close U or failedcmd @upd_cmd; +} + our $snags_forced = 0; our $snags_tripped = 0; our $snags_summarised = 0; our @deferred_updates; our @deferred_update_messages; +sub merge_wreckage_cleaning ($) { + my ($updates) = @_; + git_for_each_ref("$wrecknoteprefix/*", sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + push @$updates, "delete $fullrefname"; + }); +} + sub all_snags_summarised () { $snags_forced + $snags_tripped == $snags_summarised; } @@ -143,16 +170,8 @@ sub run_deferred_updates ($) { confess 'dangerous internal error' unless all_snags_summarised(); - my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); - debugcmd '>|', @upd_cmd; - open U, "|-", @upd_cmd or die $!; - foreach (@deferred_updates) { - printdebug ">= ", $_, "\n"; - print U $_, "\n" or die $!; - } - printdebug ">\$\n"; - close U or failedcmd @upd_cmd; - + merge_wreckage_cleaning \@deferred_updates; + run_ref_updates_now $mrest, \@deferred_updates; print $_, "\n" foreach @deferred_update_messages; @deferred_updates = (); @@ -226,7 +245,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; } @@ -261,11 +280,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; }; @@ -338,15 +361,15 @@ sub gbp_pq_export ($$$) { { local ($!,$?); copy('../gbp-pq-err', \*STDERR); } failedcmd @gbp_cmd; } - runcmd @git, qw(add -f debian/patches); + runcmd @git, qw(add -f debian/patches) if stat_exists 'debian/patches'; } -# 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) @@ -356,8 +379,41 @@ 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_failed ($$) { + my ($wrecknotes, $emsg) = @_; + my @m; + push @m, "Merge resolution failed: $emsg"; + + $opt_save_wreckage //= do { + my $c = cfg 'git-debrebase.merge.save-wreckage', 1; + # ^ xxx documentation + $c && $c =~ m/^[1ty]/; + }; + + if ($opt_save_wreckage) { + my @updates; + merge_wreckage_cleaning \@updates; + keys %$wrecknotes; + while (my ($k,$v) = each %$wrecknotes) { + push @updates, "create $wrecknoteprefix/$k $v"; + } + run_ref_updates_now "merge failed", \@updates; + push @m, "Wreckage left in $wrecknoteprefix/* as requested."; + } + push @m, "See git-debrebase(1) section FAILED MERGES for suggestions."; + # ^ xxx this section does not yet exist + fail join '', map { "$_\n" } @m; +} + +sub mwrecknote ($$$) { + my ($wrecknotes, $reftail, $commitish) = @_; + confess unless defined $commitish; + printdebug "mwrecknote $reftail $commitish\n"; + $wrecknotes->{$reftail} = $commitish; +} + +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) @@ -382,6 +438,8 @@ sub merge_series ($$;@) { my $result; + my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); }; + local $workarea = fresh_playground "$playprefix/merge"; my $seriesfile = "debian/patches/series"; in_workarea sub { @@ -389,10 +447,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 = ) { chomp $patch or die $!; + $prereq{$patch} //= {}; foreach my $earlier (@earlier) { $prereq{$patch}{$earlier}{$s}++ and die; } @@ -411,15 +470,30 @@ sub merge_series ($$;@) { " $q->{SeriesTip}]" ]; printdebug "merge_series pec $pec "; - runcmd @git, qw(rm -q --cached), $seriesfile; + runcmd @git, qw(rm -q --ignore-unmatch --cached), $seriesfile; $pec = make_commit [ $pec ], [ "Drop series file from $s to avoid merge trouble", "[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; + $mwrecknote->("$q->{LeftRight}-patchqueue", $pec); } # now, because of reverse, we are on $input_q->{MR}{OQC} runcmd @git, qw(checkout -q -b merge); @@ -501,7 +575,8 @@ 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'; + $mwrecknote->('merged-patchqueue', git_rev_parse 'HEAD'); printdebug "merge_series series gbp pq import\n"; runcmd qw(gbp pq import); @@ -515,7 +590,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; @@ -525,7 +600,17 @@ sub merge_series ($$;@) { $build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit); } $result = $build; + $mwrecknote->('merged-result', $result); + 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; + $mwrecknote->('merged-debug', $mdebug); }; printdebug "merge_series returns $result\n"; return $result; @@ -807,8 +892,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) @@ -824,6 +926,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: @@ -831,6 +935,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; @@ -843,6 +948,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}; @@ -856,10 +968,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)") @@ -891,6 +1000,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}", @@ -972,13 +1083,17 @@ sub walk ($;$$$) { }; my $nomerge = sub { - fail "something useful about failed merge attempt @_ xxx".Dumper($cl); + my ($emsg) = @_; + merge_failed $cl->{MergeWreckNotes}, $emsg; }; + my $mwrecknote = sub { &mwrecknote($cl->{MergeWreckNotes}, @_); }; + my $last_anchor; for (;;) { $cl = classify $cur; + $cl->{MergeWreckNotes} //= {}; my $ty = $cl->{Type}; my $st = $cl->{SubType}; $prline->("$cl->{CommitId} $cl->{Type}"); @@ -1078,9 +1193,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 @@ -1106,15 +1233,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->(); @@ -1125,6 +1251,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; @@ -1133,10 +1270,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 { @@ -1154,14 +1293,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 @@ -1172,25 +1311,50 @@ 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, - Anchor => $banchor }; + Anchor => $banchor, + LeftRight => 'mergebase' }; + $bbw eq $bwb 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})". @@ -1198,13 +1362,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, @@ -1229,6 +1393,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(); @@ -1256,7 +1425,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; @@ -1269,23 +1438,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 { @@ -2444,6 +2635,7 @@ getoptions_main 'anchor=s' => \@opt_anchors, '--dgit=s' => \($dgit[0]), 'force!', + '--save-wreckage', \$opt_save_wreckage, '-i:s' => sub { my ($opt,$val) = @_; badusage "git-debrebase: no cuddling to -i for git-rebase"