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 ($) {
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;
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;
-
+ run_ref_updates_now $mrest, \@deferred_updates;
print $_, "\n" foreach @deferred_update_messages;
@deferred_updates = ();
{ 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';
}
# 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;
+ git_for_each_ref("$wrecknoteprefix/*", sub {
+ my ($objid,$objtype,$fullrefname,$reftail) = @_;
+ push @updates, "delete $fullrefname";
+ });
+ 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)
my $result;
+ my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); };
+
local $workarea = fresh_playground "$playprefix/merge";
my $seriesfile = "debian/patches/series";
in_workarea sub {
foreach my $q ($base_q, reverse @input_qs) {
my $s = $q->{MR}{S};
gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
- # xxx avoid trying to merge debian/ again here, by
- # always using debian/ from newbase
+ my @earlier;
if (open S, $seriesfile) {
- my @earlier;
while (my $patch = <S>) {
chomp $patch or die $!;
$prereq{$patch} //= {};
" $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);
}
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);
$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);
- printdebug sprintf "merge_series done debug=%s\n",
- git_rev_parse 'HEAD';
+ 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;
$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;
}
};
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}");
return $bomb->();
}
die "$ty ?";
- } elsif ($ty eq 'VanillaMerge' or $ty eq 'MergedBreakwaters') {
+ } 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
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->();
$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;
" 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 {
}
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
# 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})".
(join ' ', map { $_->{Anchor} } @$ps).
")");
-
$cl->{MergeInterchangeBaseInfo} = $ibinfo;
$cl->{MergeBestAnchor} = $best_anchor;
push @brw_cl, {
} 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};
'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"
~ianmdlvl / dgit.git / blobdiff