git-debrebase: convert-from-gbp: Print a success message.

[dgit.git] / git-debrebase

diff --git a/git-debrebase b/git-debrebase
index d101742114246a8bd61f63c102bad234252b1eac..6abc86da0107890915deabe1afd51b192f3d0dbe 100755 (executable)
--- a/git-debrebase
+++ b/git-debrebase
@@ -50,11 +50,16 @@ usages:
 See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit).
 END
 
 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_careful, $opt_noop_ok, @opt_anchors);

 our ($opt_defaultcmd_interactive);
 
 our ($opt_defaultcmd_interactive);
 

+$opt_careful = 0;
+

 our $us = qw(git-debrebase);
 
 our $us = qw(git-debrebase);
 

+our $wrecknoteprefix = 'refs/debrebase/wreckage';
+our $merge_cache_ref = 'refs/debrebase/merge-resolutions';
+

 $|=1;
 
 sub badusage ($) {
 $|=1;
 
 sub badusage ($) {


@@ -107,8 +112,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_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';
 sub DS_DEB ()     { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/)
 
 our $playprefix = 'debrebase';


@@ -126,17 +131,42 @@ sub in_workarea ($) {
     die $@ if $@;
 }
 
     die $@ if $@;
 }
 

-sub fresh_workarea () {
-    $workarea = fresh_playground "$playprefix/work";
+sub fresh_workarea (;$) {
+    my ($subdir) = @_;
+    $subdir //= 'work';
+    $workarea = fresh_playground "$playprefix/$subdir";

     in_workarea sub { playtree_setup };
 }
 
     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;
 
 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;
 }
 sub all_snags_summarised () {
     $snags_forced + $snags_tripped == $snags_summarised;
 }


@@ -145,88 +175,156 @@ sub run_deferred_updates ($) {
 
     confess 'dangerous internal error' unless all_snags_summarised();
 
 
     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 = ();
     @deferred_update_messages = ();
 }
 
     print $_, "\n" foreach @deferred_update_messages;
 
     @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 (<mode> <type> <hash>)
+    # 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';
+    }
+
+    our (@get_tree_memo, %get_tree_memo);
+    my $memo = $get_tree_memo{$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{$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 [$all,] $x, $y, sub {... }
+    # calls sub->($name, $ix, $iy) for each difference (with $all, each name)
+    # $x and $y are as for get_tree
+    # where $name, $ix, $iy are $name and $info from get_tree
+    my $all = shift @_ if @_>=4;
+    my ($x,$y,$call) = @_;
+    return if !$all and $x eq $y;
+    my @x = get_tree $x;
+    my @y = get_tree $y;
+    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) = @_;
 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/.
     # 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 $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 $xp, $yp, sub {
+               my ($n,$ix,$iy) = @_;
+
+               # analyse difference in debian/patches
+
+               my $ok;
+               if ($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;
 
 
     printdebug sprintf "get_differs %s %s = %#x\n", $x, $y, $differs;
 


@@ -353,15 +451,61 @@ sub gbp_pq_export ($$$) {
 # xxx general gdr docs highlight forbidden things
 # xxx general gdr docs list allowable things ?
 # xxx general gdr 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)

 
 # later/rework?
 #  use git-format-patch?
 #  our own patch identification algorithm?
 #  this is an alternative strategy
 
 
 # later/rework?
 #  use git-format-patch?
 #  our own patch identification algorithm?
 #  this is an alternative strategy
 

+sub merge_failed ($$;@) {
+    my ($wrecknotes, $emsg, @xmsgs) = @_;
+    my @m;
+    push @m, "Merge resolution failed: $emsg";
+    push @m, @xmsgs;
+
+    changedir $maindir;
+
+    my @updates;
+    merge_wreckage_cleaning \@updates;
+    run_ref_updates_now "merge failed", \@updates;
+
+    @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/*.";
+
+    push @m, "See git-debrebase(1) section FAILED MERGES for suggestions.";
+
+    # use finish rather than fail, in case we are within an eval
+    # (that can happen inside walk!)
+    print STDERR "\n";
+    print STDERR "$us: $_\n" foreach @m;
+    finish 15;
+}
+
+sub mwrecknote ($$$) {
+    my ($wrecknotes, $reftail, $commitish) = @_;
+    confess unless defined $commitish;
+    printdebug "mwrecknote $reftail $commitish\n";
+    $wrecknotes->{$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}
 sub merge_series ($$$;@) {
     my ($newbase, $wrecknotes, $base_q, @input_qs) = @_;
     # $base_q{SeriesBase}  $input_qs[]{SeriesBase}


@@ -386,14 +530,14 @@ sub merge_series ($$$;@) {
     # $prereq{<patch filename>}{<possible prereq}  exists or not (later)
     # $prereq{<patch filename>}               exists or not (even later)
 
     # $prereq{<patch filename>}{<possible prereq}  exists or not (later)
     # $prereq{<patch filename>}               exists or not (even later)
 

-    my $result;
+    my $merged_pq;

 
 

-    my $mwrecknote = sub {
-       my ($reftail, $commitish) = @_;
-       $wrecknotes->{$reftail} = $commitish;
-    };
+    my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); };
+
+    my $attempt_cmd = sub { &merge_attempt_cmd($wrecknotes, @_); };

 
 

-    local $workarea = fresh_playground "$playprefix/merge";
+    local $workarea;
+    fresh_workarea "merge";

     my $seriesfile = "debian/patches/series";
     in_workarea sub {
        playtree_setup();
     my $seriesfile = "debian/patches/series";
     in_workarea sub {
        playtree_setup();


@@ -446,17 +590,14 @@ sub merge_series ($$$;@) {
            printdebug "pec' $pec\n";
             runcmd @git, qw(reset -q --hard), $pec;
            $q->{MR}{PEC} = $pec;
            printdebug "pec' $pec\n";
             runcmd @git, qw(reset -q --hard), $pec;
            $q->{MR}{PEC} = $pec;

-           $mwrecknote->("$q->{LeftRight}-patchqueue");
+           $mwrecknote->("$q->{LeftRight}-patchqueue", $pec);

        }
        # now, because of reverse, we are on $input_q->{MR}{OQC}
        runcmd @git, qw(checkout -q -b merge);
        printdebug "merge_series merging...\n";
        my @mergecmd = (@git, qw(merge --quiet --no-edit), "p-1");
        }
        # now, because of reverse, we are on $input_q->{MR}{OQC}
        runcmd @git, qw(checkout -q -b merge);
        printdebug "merge_series merging...\n";
        my @mergecmd = (@git, qw(merge --quiet --no-edit), "p-1");

-       debugcmd '+', @mergecmd;
-       $!=0; $?=-1;
-       if (system @mergecmd) {
-           failedcmd @mergecmd;
-       }
+
+       $attempt_cmd->(@mergecmd);

 
        printdebug "merge_series merge ok, series...\n";
        # We need to construct a new series file
 
        printdebug "merge_series merge ok, series...\n";
        # We need to construct a new series file


@@ -529,17 +670,30 @@ sub merge_series ($$$;@) {
 
        runcmd @git, qw(add), $seriesfile;
        runcmd @git, qw(commit --quiet -m), 'Merged patch queue form';
 
        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";
        printdebug "merge_series series gbp pq import\n";

-       runcmd qw(gbp pq import);
+       runcmd @git, qw(checkout -q -b mergec), $merged_pq;
+
+       merge_attempt_cmd($wrecknotes, qw(gbp pq import));

 
        # 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;
 
        # 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";
        foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) {
            my $commit = git_cat_file $c, 'commit';
            printdebug "merge_series series ok, building $c\n";


@@ -553,7 +707,7 @@ sub merge_series ($$$;@) {
            $build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit);
        }
        $result = $build;
            $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;
 
 
        runcmd @git, qw(update-ref refs/heads/result), $result;
 


@@ -563,7 +717,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;
        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;
     };
     printdebug "merge_series returns $result\n";
     return $result;


@@ -1036,18 +1190,17 @@ sub walk ($;$$$) {
     };
 
     my $nomerge = sub {
     };
 
     my $nomerge = sub {

-       fail "something useful about failed merge attempt @_ xxx".Dumper($cl);
+       my ($emsg) = @_;
+       merge_failed $cl->{MergeWreckNotes}, $emsg;

     };
 
     };
 

-    my $mwrecknote = sub {
-       my ($reftail, $commitish) = @_;
-       $cl->{MergeWreckNotes}{$reftail} = $commitish;
-    };
+    my $mwrecknote = sub { &mwrecknote($cl->{MergeWreckNotes}, @_); };

 
     my $last_anchor;
 
     for (;;) {
        $cl = classify $cur;
 
     my $last_anchor;
 
     for (;;) {
        $cl = classify $cur;

+       $cl->{MergeWreckNotes} //= {};

        my $ty = $cl->{Type};
        my $st = $cl->{SubType};
        $prline->("$cl->{CommitId} $cl->{Type}");
        my $ty = $cl->{Type};
        my $st = $cl->{SubType};
        $prline->("$cl->{CommitId} $cl->{Type}");


@@ -1292,8 +1445,9 @@ sub walk ($;$$$) {
            my ($btip, $bbw, $banchor) = eval {
                walk $ib, 0, $report, $report_lprefix.'  ';
            };
            my ($btip, $bbw, $banchor) = eval {
                walk $ib, 0, $report, $report_lprefix.'  ';
            };

-           $nomerge->("walking interchange branch merge base ($ibleaf): ".
-                      $@) if length $@;
+           $nomerge->("walking interchange branch merge base ($ibleaf):\n".
+                      $@)
+               if length $@;

 
            $mwrecknote->("mergebase-laundered", $btip);
            $mwrecknote->("mergebase-breakwater", $bbw);
 
            $mwrecknote->("mergebase-laundered", $btip);
            $mwrecknote->("mergebase-breakwater", $bbw);


@@ -1347,11 +1501,6 @@ sub walk ($;$$$) {
 
     my $rewriting = 0;
 
 
     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();
     $#upp_cl = $upp_limit if defined $upp_limit;
  
     my $committer_authline = calculate_committer_authline();


@@ -1363,7 +1512,12 @@ sub walk ($;$$$) {
     in_workarea sub {
        mkdir $rd or $!==EEXIST or die $!;
        my $current_method;
     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)) {
        foreach my $cl (qw(Debian), (reverse @brw_cl),
                        { SpecialMethod => 'RecordBreakwaterTip' },
                        qw(Upstream), (reverse @upp_cl)) {


@@ -1377,7 +1531,7 @@ sub walk ($;$$$) {
            printdebug "WALK BUILD ".($cltree//'undef').
                " $method (rewriting=$rewriting)\n";
            if ($method eq 'Debian') {
            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') {
            } elsif ($method eq 'Upstream') {
                $read_tree_upstream->($cltree);
            } elsif ($method eq 'StartRewrite') {


@@ -1387,7 +1541,7 @@ sub walk ($;$$$) {
                $breakwater = $build;
                next;
            } elsif ($method eq 'DgitImportDebianUpdate') {
                $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);
            } elsif ($method eq 'DgitImportUpstreamUpdate') {
                confess unless $rewriting;
                my $differs = (get_differs $build, $cltree);


@@ -1398,15 +1552,23 @@ sub walk ($;$$$) {
                print "Found a general merge, will try to tidy it up.\n";
                $rewriting = 1;
                $read_tree_upstream->($cl->{MergeBestAnchor});
                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') {
                @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:
                $last_anchor = $cl->{MergeBestAnchor};
 
                # Check for mismerges:


@@ -1443,27 +1605,46 @@ sub walk ($;$$$) {
                    printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n";
                }
            }
                    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 ?";
+           if ($rewriting || $opt_careful) {
+               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;
             }
             if (grep { $method eq $_ } qw(DgitImportUpstreamUpdate)) {
                 $last_anchor = $cur;
             }


@@ -1498,7 +1679,7 @@ sub update_head_checkout ($$$) {
 
 sub update_head_postlaunder ($$$) {
     my ($old, $tip, $reflogmsg) = @_;
 
 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
     print "git-debrebase: laundered (head was $old)\n";
     update_head $old, $tip, $reflogmsg;
     # no tree changes except debian/patches


@@ -2101,7 +2282,10 @@ sub cmd_stitch () {
     badusage "no arguments allowed" if @ARGV;
     do_stitch $prose, 0;
 }
     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;
 
 sub cmd_quick () {
     badusage "no arguments allowed" if @ARGV;


@@ -2125,19 +2309,32 @@ sub cmd_conclude () {
 sub cmd_scrap () {
     if (currently_rebasing()) {
        runcmd @git, qw(rebase --abort);
 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();
     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;
     }
        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();
     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 ($) {
 }
 
 sub make_patches_staged ($) {


@@ -2193,6 +2390,24 @@ 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;
+    foreach my $f (grep /\S/, grep {!m/^\s\#/} split /\n/, $series) {
+       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 cmd_convert_from_gbp () {
     badusage "want only 1 optional argument, the upstream git commitish"
        unless @ARGV<=1;
 sub cmd_convert_from_gbp () {
     badusage "want only 1 optional argument, the upstream git commitish"
        unless @ARGV<=1;


@@ -2240,6 +2455,8 @@ END
            "upstream ($upstream) contains debian/ directory";
     }
 
            "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);
     my $previous_dgit_view = eval {
        my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2);
        my ($lvsn, $suite);


@@ -2316,6 +2533,9 @@ END
     ffq_check $work;
     snags_maybe_bail();
     update_head_checkout $old_head, $work, 'convert-from-gbp';
     ffq_check $work;
     snags_maybe_bail();
     update_head_checkout $old_head, $work, 'convert-from-gbp';

+    print <<END or die $!;
+git-debrebase: converted from patched-unapplied (gbp) branch format, OK
+END

 }
 
 sub cmd_convert_to_gbp () {
 }
 
 sub cmd_convert_to_gbp () {


@@ -2390,6 +2610,8 @@ END
        }
     }
 
        }
     }
 

+    check_series_has_all_patches $head;
+

     snags_maybe_bail_early();
 
     my $version = upstreamversion $clogp->{Version};
     snags_maybe_bail_early();
 
     my $version = upstreamversion $clogp->{Version};


@@ -2532,6 +2754,46 @@ END
        'convert-from-dgit-view';
 }
 
        'convert-from-dgit-view';
 }
 

+sub cmd_record_resolved_merge () {
+    badusage "record-resolved-merge takes no further arguments" if @ARGV;
+    # xxx 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;
 sub cmd_downstream_rebase_launder_v0 () {
     badusage "needs 1 argument, the baseline" unless @ARGV==1;
     my ($base) = @ARGV;