X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=a67008f7ed4039d083eb59fe522a5756a133d5f2;hp=3ac087c980034a3a4812b97ec6d8a5b21c4b1e07;hb=8c94cb4bc182dc63bd51adb430c1649dbb3da37e;hpb=612dca82a7f17f88835f495155fe3ff1502e336c diff --git a/git-debrebase b/git-debrebase index 3ac087c9..a67008f7 100755 --- a/git-debrebase +++ b/git-debrebase @@ -50,12 +50,13 @@ usages: See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit). END -our ($opt_force, $opt_noop_ok, @opt_anchors); +our ($opt_force, $opt_noop_ok, $opt_merges, @opt_anchors); our ($opt_defaultcmd_interactive); our $us = qw(git-debrebase); -our $wrecknoteprefix = 'refs/debrebase-wreckage'; +our $wrecknoteprefix = 'refs/debrebase/wreckage'; +our $merge_cache_ref = 'refs/debrebase/merge-resolutions'; $|=1; @@ -109,8 +110,8 @@ sub get_commit ($) { sub D_UPS () { 0x02; } # upstream files sub D_PAT_ADD () { 0x04; } # debian/patches/ extra patches at end sub D_PAT_OTH () { 0x08; } # debian/patches other changes -sub D_DEB_CLOG () { 0x10; } # debian/ (not patches/ or changelog) -sub D_DEB_OTH () { 0x20; } # debian/changelog +sub D_DEB_CLOG () { 0x10; } # debian/changelog +sub D_DEB_OTH () { 0x20; } # debian/ (not patches/ or changelog) sub DS_DEB () { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/) our $playprefix = 'debrebase'; @@ -180,72 +181,158 @@ sub run_deferred_updates ($) { @deferred_update_messages = (); } +sub get_tree ($;$$) { + # tree object name => ([ $name, $info ], ...) + # where $name is the sort key, ie has / at end for subtrees + # $info is the LHS from git-ls-tree ( ) + # without $precheck, will crash if $x does not exist, so don't do that; + # instead pass '' to get (). + my ($x, $precheck, $recurse) = @_; + + return () if !length $x; + + if ($precheck) { + my ($type, $dummy) = git_cat_file $x, [qw(tree missing)]; + return () if $type eq 'missing'; + } + + $recurse = !!$recurse; + + confess "get_tree needs object not $x ?" unless $x =~ m{^[0-9a-f]+\:}; + + our (@get_tree_memo, %get_tree_memo); + my $memo = $get_tree_memo{$recurse,$x}; + return @$memo if $memo; + + local $Debian::Dgit::debugcmd_when_debuglevel = 3; + my @l; + my @cmd = (qw(git ls-tree -z --full-tree)); + push @cmd, qw(-r) if $recurse; + push @cmd, qw(--), $x; + my $o = cmdoutput @cmd; + $o =~ s/\0$//s; + my $last = ''; + foreach my $l (split /\0/, $o) { + my ($i, $n) = split /\t/, $l, 2; + $n .= '/' if $i =~ m/^\d+ tree /; + push @l, [ $n, $i ]; + confess "$x need $last < $n ?" unless $last lt $n; + } + $get_tree_memo{$recurse,$x} = \@l; + push @get_tree_memo, $x; + if (@get_tree_memo > 10) { + delete $get_tree_memo{ shift @get_tree_memo }; + } + return @l; +} + +sub trees_diff_walk ($$$;$) { + # trees_diff_walk [{..opts...},] $x, $y, sub {... } + # calls sub->($name, $ix, $iy) for each difference + # $x and $y are as for get_tree + # where $name, $ix, $iy are $name and $info from get_tree + # opts are all call even for names same in both + # recurse call even for names same in both + my $opts = shift @_ if @_>=4; + my ($x,$y,$call) = @_; + my $all = $opts->{all}; + return if !$all and $x eq $y; + my @x = get_tree $x, 0, $opts->{recurse}; + my @y = get_tree $y, 0, $opts->{recurse}; + printdebug "trees_diff_walk(..$x,$y..) ".Dumper(\@x,\@y) + if $debuglevel >= 3; + while (@x || @y) { + my $cmp = !@x <=> !@y # eg @y empty? $cmp=-1, use x + || $x[0][0] cmp $y[0][0]; # eg, x lt y ? $cmp=-1, use x + my ($n, $ix, $iy); # all same? $cmp=0, use both + $ix=$iy=''; + printdebug "trees_diff_walk $cmp : @{ $x[0]//[] } | @{ $y[0]//[] }\n" + if $debuglevel >= 3; + ($n, $ix) = @{ shift @x } if $cmp <= 0; + ($n, $iy) = @{ shift @y } if $cmp >= 0; + next if !$all and $ix eq $iy; + printdebug sprintf + "trees_diff_walk(%d,'%s','%s') call('%s','%s','%s')\n", + !!$all,$x,$y, $n,$ix,$iy + if $debuglevel >= 2; + $call->($n, $ix, $iy); + } +} + sub get_differs ($$) { my ($x,$y) = @_; - # This resembles quiltify_trees_differ, in dgit, a bit. + # This does a similar job to quiltify_trees_differ, in dgit, a bit. # But we don't care about modes, or dpkg-source-unrepresentable # changes, and we don't need the plethora of different modes. # Conversely we need to distinguish different kinds of changes to # debian/ and debian/patches/. + # Also, here we have, and want to use, trees_diff_walk, because + # we may be calling this an awful lot and we want it to be fast. my $differs = 0; + my @debian_info; - my $rundiff = sub { - my ($opts, $limits, $fn) = @_; - my @cmd = (@git, qw(diff-tree -z --no-renames)); - push @cmd, @$opts; - push @cmd, "$_:" foreach $x, $y; - push @cmd, '--', @$limits; - my $diffs = cmdoutput @cmd; - foreach (split /\0/, $diffs) { $fn->(); } - }; + no warnings qw(exiting); - $rundiff->([qw(--name-only)], [], sub { - $differs |= $_ eq 'debian' ? DS_DEB : D_UPS; - }); + my $plain = sub { $_[0] =~ m{^(100|0*)644 blob }s; }; - if ($differs & DS_DEB) { - $differs &= ~DS_DEB; - $rundiff->([qw(--name-only -r)], [qw(debian)], sub { - $differs |= - m{^debian/patches/} ? D_PAT_OTH : - $_ eq 'debian/changelog' ? D_DEB_CLOG : - D_DEB_OTH; - }); - die "mysterious debian changes $x..$y" - unless $differs & (D_PAT_OTH|DS_DEB); - } - - if ($differs & D_PAT_OTH) { - my $mode; - $differs &= ~D_PAT_OTH; - my $pat_oth = sub { - $differs |= D_PAT_OTH; - no warnings qw(exiting); last; - }; - $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub { - no warnings qw(exiting); - if (!defined $mode) { - $mode = $_; next; + trees_diff_walk "$x:", "$y:", sub { + my ($n,$ix,$iy) = @_; + + # analyse difference at the toplevel + + if ($n ne 'debian/') { + $differs |= D_UPS; + next; + } + if ($n eq 'debian') { + # one side has a non-tree for ./debian ! + $differs |= D_DEB_OTH; + next; + } + + my $xd = $ix && "$x:debian"; + my $yd = $iy && "$y:debian"; + trees_diff_walk $xd, $yd, sub { + my ($n,$ix,$iy) = @_; + + # analyse difference in debian/ + + if ($n eq 'changelog' && (!$ix || $plain->($ix)) + && $plain->($iy) ) { + $differs |= D_DEB_CLOG; + next; } - die unless s{^debian/patches/}{}; - my $ok; - if ($mode eq 'A' && !m/\.series$/s) { - $ok = 1; - } elsif ($mode eq 'M' && $_ eq 'series') { - my $x_s = (git_cat_file "$x:debian/patches/series", 'blob'); - my $y_s = (git_cat_file "$y:debian/patches/series", 'blob'); - chomp $x_s; $x_s .= "\n"; - $ok = $x_s eq substr($y_s, 0, length $x_s); - } else { - # nope + if ($n ne 'patches/') { + $differs |= D_DEB_OTH; + next; } - $mode = undef; - $differs |= $ok ? D_PAT_ADD : D_PAT_OTH; - }); - die "mysterious debian/patches changes $x..$y" - unless $differs & (D_PAT_ADD|D_PAT_OTH); - } + + my $xp = $ix && "$xd/patches"; + my $yp = $iy && "$yd/patches"; + trees_diff_walk { recurse=>1 }, $xp, $yp, sub { + my ($n,$ix,$iy) = @_; + + # analyse difference in debian/patches + + my $ok; + if ($n =~ m{/$}s) { + # we are recursing; directories may appear and disappear + $ok = 1; + } elsif ($n !~ m/\.series$/s && !$ix && $plain->($iy)) { + $ok = 1; + } elsif ($n eq 'series' && $plain->($ix) && $plain->($iy)) { + my $x_s = (git_cat_file "$xp/series", 'blob'); + my $y_s = (git_cat_file "$yp/series", 'blob'); + chomp $x_s; $x_s .= "\n"; + $ok = $x_s eq substr($y_s, 0, length $x_s); + } else { + # nope + } + $differs |= $ok ? D_PAT_ADD : D_PAT_OTH; + }; + }; + }; printdebug sprintf "get_differs %s %s = %#x\n", $x, $y, $differs; @@ -349,11 +436,65 @@ sub any_snags () { return $snags_forced || $snags_tripped; } +sub ffq_prev_branchinfo () { + my $current = git_get_symref(); + return gdr_ffq_prev_branchinfo($current); +} + +sub record_gdrlast ($$;$) { + my ($gdrlast, $newvalue, $oldvalue) = @_; + $oldvalue ||= $git_null_obj; + push @deferred_updates, "update $gdrlast $newvalue $oldvalue"; +} + +sub fail_unprocessable ($) { + my ($msg) = @_; + changedir $maindir; + my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo(); + + my $mangled = <{$reftail} = $commitish; } +sub merge_attempt_cmd { + my $wrecknotes = shift @_; + debugcmd '+', @_; + $!=0; $?=-1; + if (system @_) { + merge_failed $wrecknotes, + failedcmd_waitstatus(), + "failed command: @_"; + } +} + +sub merge_series_patchqueue_convert ($$$); + sub merge_series ($$$;@) { my ($newbase, $wrecknotes, $base_q, @input_qs) = @_; # $base_q{SeriesBase} $input_qs[]{SeriesBase} @@ -438,19 +590,11 @@ sub merge_series ($$$;@) { # $prereq{}{} exists or not (even later) - my $result; + my $merged_pq; my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); }; - my $attempt_cmd = sub { - debugcmd '+', @_; - $!=0; $?=-1; - if (system @_) { - merge_failed $wrecknotes, - failedcmd_waitstatus(), - "failed command: @_"; - } - }; + my $attempt_cmd = sub { &merge_attempt_cmd($wrecknotes, @_); }; local $workarea; fresh_workarea "merge"; @@ -586,18 +730,32 @@ sub merge_series ($$$;@) { runcmd @git, qw(add), $seriesfile; runcmd @git, qw(commit --quiet -m), 'Merged patch queue form'; - $mwrecknote->('merged-patchqueue', git_rev_parse 'HEAD'); + $merged_pq = git_rev_parse 'HEAD'; + $mwrecknote->('merged-patchqueue', $merged_pq); + }; + return merge_series_patchqueue_convert + $wrecknotes, $newbase, $merged_pq; +} +sub merge_series_patchqueue_convert ($$$) { + my ($wrecknotes, $newbase, $merged_pq) = @_; + + my $result; + in_workarea sub { + playtree_setup(); printdebug "merge_series series gbp pq import\n"; + runcmd @git, qw(checkout -q -b mergec), $merged_pq; - $attempt_cmd->(qw(gbp pq import)); + merge_attempt_cmd($wrecknotes, qw(gbp pq import)); + # MERGE-TODO consider git-format-patch etc. instead, + # since gbp pq doesn't always round-trip :-/ # OK now we are on patch-queue/merge, and we need to rebase # onto the intended parent and drop the patches from each one printdebug "merge_series series ok, building...\n"; my $build = $newbase; - my @lcmd = (@git, qw(rev-list --reverse merge..patch-queue/merge)); + my @lcmd = (@git, qw(rev-list --reverse mergec..patch-queue/mergec)); foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) { my $commit = git_cat_file $c, 'commit'; printdebug "merge_series series ok, building $c\n"; @@ -611,7 +769,7 @@ sub merge_series ($$$;@) { $build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit); } $result = $build; - $mwrecknote->('merged-result', $result); + mwrecknote($wrecknotes, 'merged-result', $result); runcmd @git, qw(update-ref refs/heads/result), $result; @@ -621,7 +779,7 @@ sub merge_series ($$$;@) { 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); + mwrecknote($wrecknotes, 'merged-debug', $mdebug); }; printdebug "merge_series returns $result\n"; return $result; @@ -886,7 +1044,6 @@ sub classify ($) { if (@p == 2 and $r->{Msg} =~ m{^\[git-debrebase merged-breakwater.*\]$}m) { - # xxx ^ metadata tag needs adding to (5) return $classify->("MergedBreakwaters"); } if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) { @@ -896,7 +1053,7 @@ sub classify ($) { return $unknown->("octopus merge"); } - if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) { + if (!$opt_merges) { return $unknown->("general two-parent merge"); } @@ -950,7 +1107,7 @@ sub keycommits ($;$$$$$) { my $clogonly; my $cl; my $found_pm; - $fatal //= sub { fail $_[1]; }; + $fatal //= sub { fail_unprocessable $_[1]; }; my $x = sub { my ($cb, $tagsfx, $mainwhy, $xwhy) = @_; my $why = $mainwhy.$xwhy; @@ -1047,8 +1204,8 @@ sub walk ($;$$$) { my ($prose, $info) = @_; my $ms = $cl->{Msg}; chomp $ms; - $info //= ''; - $ms .= "\n\n[git-debrebase$info: $prose]\n"; + confess unless defined $info; + $ms .= "\n\n[git-debrebase $info: $prose]\n"; return (Msg => $ms); }; my $rewrite_from_here = sub { @@ -1075,7 +1232,7 @@ sub walk ($;$$$) { if ($nogenerate) { return (undef,undef); } - fail "found unprocessable commit, cannot cope". + fail_unprocessable "found unprocessable commit, cannot cope". (defined $cl->{Why} ? "; $cl->{Why}:": ':'). " (commit $cur) (d.". (join ' ', map { sprintf "%#x", $_->{Differs} } @@ -1129,7 +1286,7 @@ sub walk ($;$$$) { } elsif ($ty eq 'Mixed') { my $queue = sub { my ($q, $wh) = @_; - my $cls = { %$cl, $xmsg->("split mixed commit: $wh part") }; + my $cls = { %$cl, $xmsg->("mixed commit: $wh part",'split') }; push @$q, $cls; }; $queue->(\@brw_cl, "debian"); @@ -1182,12 +1339,12 @@ sub walk ($;$$$) { push @brw_cl, { %$cl, SpecialMethod => 'DgitImportDebianUpdate', - $xmsg->("convert dgit import: debian changes") + $xmsg->("debian changes", 'convert dgit import') }, { %$cl, SpecialMethod => 'DgitImportUpstreamUpdate', $xmsg->("convert dgit import: upstream update", - " anchor") + "anchor") }; $prline->(" Import"); $rewrite_from_here->(\@brw_cl); @@ -1217,7 +1374,7 @@ sub walk ($;$$$) { # 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 + # MERGE-TODO we should warn the user in the docs about this my $ok=1; my $best_anchor; @@ -1380,7 +1537,7 @@ sub walk ($;$$$) { %$cl, SpecialMethod => 'MergeCreateMergedBreakwaters', $xmsg->('constructed from vanilla merge', - ' merged-breakwater'), + 'merged-breakwater'), }; push @upp_cl, { %$cl, @@ -1405,11 +1562,6 @@ 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(); @@ -1421,7 +1573,12 @@ sub walk ($;$$$) { in_workarea sub { mkdir $rd or $!==EEXIST or die $!; my $current_method; - runcmd @git, qw(read-tree), $build; + my $want_debian = $build; + my $want_upstream = $build; + + my $read_tree_upstream = sub { ($want_upstream) = @_; }; + my $read_tree_debian = sub { ($want_debian) = @_; }; + foreach my $cl (qw(Debian), (reverse @brw_cl), { SpecialMethod => 'RecordBreakwaterTip' }, qw(Upstream), (reverse @upp_cl)) { @@ -1435,7 +1592,7 @@ sub walk ($;$$$) { printdebug "WALK BUILD ".($cltree//'undef'). " $method (rewriting=$rewriting)\n"; if ($method eq 'Debian') { - read_tree_debian($cltree); + $read_tree_debian->($cltree); } elsif ($method eq 'Upstream') { $read_tree_upstream->($cltree); } elsif ($method eq 'StartRewrite') { @@ -1445,7 +1602,7 @@ sub walk ($;$$$) { $breakwater = $build; next; } elsif ($method eq 'DgitImportDebianUpdate') { - read_tree_debian($cltree); + $read_tree_debian->($cltree); } elsif ($method eq 'DgitImportUpstreamUpdate') { confess unless $rewriting; my $differs = (get_differs $build, $cltree); @@ -1456,15 +1613,23 @@ sub walk ($;$$$) { 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_debian($cltree); + $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, $cl->{MergeWreckNotes}, - $cl->{MergeInterchangeBaseInfo}, - @{ $cl->{Parents} }; + my $cachehit = reflog_cache_lookup + $merge_cache_ref, "vanilla-merge $cl->{CommitId}"; + if ($cachehit) { + print "Using supplied resolution for $cl->{CommitId}...\n"; + $build = $cachehit; + $mwrecknote->('cached-resolution', $build); + } else { + print "Running merge resolution for $cl->{CommitId}...\n"; + $mwrecknote->('new-base', $build); + $build = merge_series + $build, $cl->{MergeWreckNotes}, + $cl->{MergeInterchangeBaseInfo}, + @{ $cl->{Parents} }; + } $last_anchor = $cl->{MergeBestAnchor}; # Check for mismerges: @@ -1501,27 +1666,46 @@ sub walk ($;$$$) { printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n"; } } - my $newtree = cmdoutput @git, qw(write-tree); - my $ch = $cl->{Hdr}; - $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?"; - $ch =~ s{^parent .*\n}{}mg; - $ch =~ s{(?=^author)}{ - join '', map { "parent $_\n" } @parents - }me or confess "$ch ?"; if ($rewriting) { - $ch =~ s{^committer .*$}{$committer_authline}m - or confess "$ch ?"; + read_tree_upstream $want_upstream, 0, $want_debian; + + my $newtree = cmdoutput @git, qw(write-tree); + my $ch = $cl->{Hdr}; + $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?"; + $ch =~ s{^parent .*\n}{}mg; + $ch =~ s{(?=^author)}{ + join '', map { "parent $_\n" } @parents + }me or confess "$ch ?"; + if ($rewriting) { + $ch =~ s{^committer .*$}{$committer_authline}m + or confess "$ch ?"; + } + my $cf = "$rd/m$rewriting"; + open CD, ">", $cf or die $!; + print CD $ch, "\n", $cl->{Msg} or die $!; + close CD or die $!; + my @cmd = (@git, qw(hash-object)); + push @cmd, qw(-w) if $rewriting; + push @cmd, qw(-t commit), $cf; + my $newcommit = cmdoutput @cmd; + confess "$ch ?" unless $rewriting + or $newcommit eq $cl->{CommitId}; + $build = $newcommit; + } else { + $build = $cl->{CommitId}; + trees_diff_walk "$want_upstream:", "$build:", sub { + my ($n) = @_; + no warnings qw(exiting); + next if $n eq 'debian/'; + confess "mismatch @_ ?"; + }; + trees_diff_walk "$want_debian:debian", "$build:debian", sub { + confess "mismatch @_ ?"; + }; + my @old_parents = map { $_->{CommitId} } @{ $cl->{Parents} }; + confess "mismatch @parents != @old_parents ?" + unless "@parents" eq "@old_parents"; } - my $cf = "$rd/m$rewriting"; - open CD, ">", $cf or die $!; - print CD $ch, "\n", $cl->{Msg} or die $!; - close CD or die $!; - my @cmd = (@git, qw(hash-object)); - push @cmd, qw(-w) if $rewriting; - push @cmd, qw(-t commit), $cf; - my $newcommit = cmdoutput @cmd; - confess "$ch ?" unless $rewriting or $newcommit eq $cl->{CommitId}; - $build = $newcommit; if (grep { $method eq $_ } qw(DgitImportUpstreamUpdate)) { $last_anchor = $cur; } @@ -1556,7 +1740,7 @@ sub update_head_checkout ($$$) { sub update_head_postlaunder ($$$) { my ($old, $tip, $reflogmsg) = @_; - return if $tip eq $old; + return if $tip eq $old && !@deferred_updates; print "git-debrebase: laundered (head was $old)\n"; update_head $old, $tip, $reflogmsg; # no tree changes except debian/patches @@ -1615,11 +1799,6 @@ sub cmd_analyse () { STDOUT->error and die $!; } -sub ffq_prev_branchinfo () { - my $current = git_get_symref(); - return gdr_ffq_prev_branchinfo($current); -} - sub ffq_check ($;$$) { # calls $ff and/or $notff zero or more times # then returns either (status,message) where status is @@ -1761,8 +1940,7 @@ sub stitch ($$$$$) { # ffq-prev is ahead of us, and the only tree changes it has # are possibly addition of things in debian/patches/. # Just wind forwards rather than making a pointless pseudomerge. - push @deferred_updates, - "update $gdrlast $ffq_prev_commitish $git_null_obj"; + record_gdrlast $gdrlast, $ffq_prev_commitish; update_head_checkout $old_head, $ffq_prev_commitish, "stitch (fast forward)"; return; @@ -1775,7 +1953,7 @@ sub stitch ($$$$$) { 'Declare fast forward / record previous work', "[git-debrebase pseudomerge: $prose]", ]; - push @deferred_updates, "update $gdrlast $new_head $git_null_obj"; + record_gdrlast $gdrlast, $new_head; update_head $old_head, $new_head, "stitch: $prose"; } @@ -2023,7 +2201,7 @@ END # Now we have the final new breakwater branch in the index $new_bw = make_commit [ $new_bw ], [ "Update changelog for new upstream $new_upstream_version", - "[git-debrebase: new upstream $new_upstream_version, changelog]", + "[git-debrebase changelog: new upstream $new_upstream_version]", ]; }; @@ -2159,7 +2337,10 @@ sub cmd_stitch () { badusage "no arguments allowed" if @ARGV; do_stitch $prose, 0; } -sub cmd_prepush () { cmd_stitch(); } +sub cmd_prepush () { + $opt_noop_ok = 1; + cmd_stitch(); +} sub cmd_quick () { badusage "no arguments allowed" if @ARGV; @@ -2183,19 +2364,32 @@ sub cmd_conclude () { sub cmd_scrap () { if (currently_rebasing()) { runcmd @git, qw(rebase --abort); + push @deferred_updates, 'verify HEAD HEAD'; + # noop, but stops us complaining that scrap was a noop } + badusage "no arguments allowed" if @ARGV; my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info(); - if (!$ffq_prev_commitish) { + my $scrapping_head; + if ($ffq_prev_commitish) { + $scrapping_head = get_head(); + push @deferred_updates, + "update $gdrlast $ffq_prev_commitish $git_null_obj", + "update $ffq_prev $git_null_obj $ffq_prev_commitish"; + } + if (git_get_ref $merge_cache_ref) { + push @deferred_updates, + "delete $merge_cache_ref"; + } + if (!@deferred_updates) { fail "No ongoing git-debrebase session." unless $opt_noop_ok; finish 0; } - my $scrapping_head = get_head(); - badusage "no arguments allowed" if @ARGV; - push @deferred_updates, - "update $gdrlast $ffq_prev_commitish $git_null_obj", - "update $ffq_prev $git_null_obj $ffq_prev_commitish"; snags_maybe_bail(); - update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap"; + if ($scrapping_head) { + update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap"; + } else { + run_deferred_updates "scrap"; + } } sub make_patches_staged ($) { @@ -2204,9 +2398,11 @@ sub make_patches_staged ($) { # laundered. my ($secret_head, $secret_bw, $last_anchor) = walk $head; fresh_workarea(); + my $any; in_workarea sub { - gbp_pq_export 'bw', $secret_bw, $secret_head; + $any = gbp_pq_export 'bw', $secret_bw, $secret_head; }; + return $any; } sub make_patches ($) { @@ -2220,7 +2416,7 @@ sub make_patches ($) { read_tree_subdir 'debian/patches', $ptree; $out = make_commit [$head], [ 'Commit patch queue (exported by git-debrebase)', - '[git-debrebase: export and commit patches]', + '[git-debrebase make-patches: export and commit patches]', ]; }; return $out; @@ -2251,6 +2447,54 @@ sub cmd_make_patches () { } } +sub check_series_has_all_patches ($) { + my ($head) = @_; + my $seriesfn = 'debian/patches/series'; + my ($dummy, $series) = git_cat_file "$head:$seriesfn", + [qw(blob missing)]; + $series //= ''; + my %series; + our $comments_snagged; + foreach my $f (grep /\S/, grep {!m/^\s\#/} split /\n/, $series) { + if ($f =~ m/^\s*\#/) { + snag 'series-comments', + "$seriesfn contains comments, which will be discarded" + unless $comments_snagged++; + next; + } + fail "patch $f repeated in $seriesfn !" if $series{$f}++; + } + foreach my $patchfile (get_tree "$head:debian/patches", 1,1) { + my ($f,$i) = @$patchfile; + next if $series{$f}; + next if $f eq 'series'; + snag 'unused-patches', "Unused patch file $f will be discarded"; + } +} + +sub begin_convert_from () { + my $head = get_head(); + my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo(); + + fail "ffq-prev exists, this is already managed by git-debrebase!" + if $ffq_prev && git_get_ref $ffq_prev; + + my $gdrlast_obj = $gdrlast && git_get_ref $gdrlast; + snag 'already-converted', + "ahead of debrebase-last, this is already managed by git-debrebase!" + if $gdrlast_obj && is_fast_fwd $gdrlast_obj, $head; + return ($head, { LastRef => $gdrlast, LastObj => $gdrlast_obj }); +} + +sub complete_convert_from ($$$$) { + my ($old_head, $new_head, $gi, $mrest) = @_; + ffq_check $new_head; + record_gdrlast $gi->{LastRef}, $new_head, $gi->{LastObj} + if $gi->{LastRef}; + snags_maybe_bail(); + update_head_checkout $old_head, $new_head, $mrest; +} + sub cmd_convert_from_gbp () { badusage "want only 1 optional argument, the upstream git commitish" unless @ARGV<=1; @@ -2265,7 +2509,7 @@ sub cmd_convert_from_gbp () { my $upstream = resolve_upstream_version($upstream_spec, $upstream_version); - my $old_head = get_head(); + my ($old_head, $gdrlastinfo) = begin_convert_from(); my $upsdiff = get_differs $upstream, $old_head; if ($upsdiff & D_UPS) { @@ -2298,6 +2542,8 @@ END "upstream ($upstream) contains debian/ directory"; } + check_series_has_all_patches $old_head; + my $previous_dgit_view = eval { my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2); my ($lvsn, $suite); @@ -2318,19 +2564,25 @@ END my $mtag = cmdoutput @git, qw(describe --always --abbrev=0 --match), $mtag_pat; die "could not find suitable maintainer view tag $mtag_pat\n" - unless $mtag_pat =~ m{/}; + unless $mtag =~ m{/}; is_fast_fwd $mtag, 'HEAD' or die "HEAD is not FF from maintainer tag $mtag!"; my $dtag = "archive/$mtag"; + git_get_ref "refs/tags/$dtag" or + die "dgit view tag $dtag not found\n"; is_fast_fwd $mtag, $dtag or - die "dgit view tag $dtag is not FF from maintainer tag $mtag"; + die "dgit view tag $dtag is not FF from maintainer tag $mtag\n"; print "will stitch in dgit view, $dtag\n"; git_rev_parse $dtag; }; if (!$previous_dgit_view) { $@ =~ s/^\n+//; chomp $@; - print STDERR "cannot stitch in dgit view: $@\n"; + print STDERR <{Version}; @@ -2500,7 +2760,7 @@ Import effective orig tree for upstream version $version END This includes the contents of the .orig(s), minus any debian/ directory. -[git-debrebase import-from-dgit-view upstream-import-convert: $version] +[git-debrebase convert-from-dgit-view upstream-import-convert: $version] END ]; push @upstreams, { Commit => $ups_synth, @@ -2534,7 +2794,7 @@ END 'git-debrebase convert-from-dgit-view: drop upstream changes from breakwater', "Drop upstream changes, and delete debian/patches, as part of converting\n". "to git-debrebase format. Upstream changes will appear as commits.", - '[git-debrebase convert-from-dgit-view: drop patches from tree]' + '[git-debrebase convert-from-dgit-view drop-patches]' ]; } $work = make_commit [ $work, $u->{Commit} ], [ @@ -2584,12 +2844,62 @@ END printf STDERR "Yes, will base new branch on %s\n", $result->{Source}; - ffq_check $result->{Result}; - snags_maybe_bail(); - update_head_checkout $head, $result->{Result}, + complete_convert_from $head, $result->{Result}, $gdrlastinfo, 'convert-from-dgit-view'; } +sub cmd_forget_was_ever_debrebase () { + badusage "forget-was-ever-debrebase takes no further arguments" if @ARGV; + my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) = + ffq_prev_branchinfo(); + fail "Not suitable for recording git-debrebaseness anyway: $ffq_msg" + if defined $ffq_msg; + push @deferred_updates, "delete $ffq_prev"; + push @deferred_updates, "delete $gdrlast"; + snags_maybe_bail(); + run_deferred_updates "forget-was-ever-debrebase"; +} + +sub cmd_record_resolved_merge () { + badusage "record-resolved-merge takes no further arguments" if @ARGV; + # MERGE-TODO needs documentation + my $new = get_head(); + my $method; + + print "Checking how you have resolved the merge problem\n"; + my $nope = sub { print "Not $method: @_"; 0; }; + + my $maybe = sub { print "Seems to be $method.\n"; }; + my $yes = sub { + my ($key, $ref) = @_; + reflog_cache_insert $merge_cache_ref, $key, $ref; + print "OK. You can switch branches and try git-debrebase again.\n"; + 1; + }; + + fresh_workarea 'merge'; + sub { + $method = 'vanilla-merge patchqueue'; + my $vanilla = git_get_ref "$wrecknoteprefix/vanilla-merge"; + $vanilla or return $nope->("wreckage was not of vanilla-merge"); + foreach my $lr (qw(left right)) { + my $n = "$wrecknoteprefix/$lr-patchqueue"; + my $lrpq = git_get_ref $n; + $lrpq or return $nope->("wreckage did not contain patchqueues"); + is_fast_fwd $lrpq, $new or return $nope->("HEAD not ff of $n"); + } + $maybe->(); + my $newbase = git_get_ref "$wrecknoteprefix/new-base" + or die "wreckage element $wrecknoteprefix/new-base missing"; + my $result = merge_series_patchqueue_convert + {}, $newbase, $new; + $yes->("vanilla-merge $vanilla", $result); + 1; + }->() or sub { + fail "No resolved merge method seems applicable.\n"; + }->(); +} + sub cmd_downstream_rebase_launder_v0 () { badusage "needs 1 argument, the baseline" unless @ARGV==1; my ($base) = @ARGV; @@ -2647,6 +2957,7 @@ getoptions_main 'anchor=s' => \@opt_anchors, '--dgit=s' => \($dgit[0]), 'force!', + 'experimental-merge-resolution!', \$opt_merges, '-i:s' => sub { my ($opt,$val) = @_; badusage "git-debrebase: no cuddling to -i for git-rebase"