chiark / gitweb /
git-debrebase: record_gdrlast: Honour $oldvalue
[dgit.git] / git-debrebase
index bd93fbd..630b8c2 100755 (executable)
@@ -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';
@@ -128,8 +129,10 @@ sub in_workarea ($) {
     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 };
 }
 
@@ -178,72 +181,150 @@ 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 (<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';
+    }
+
+    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{$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) = @_;
-    # 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 $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;
 
@@ -347,6 +428,17 @@ 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 gbp_pq_export ($$$) {
     my ($bname, $base, $tip) = @_;
     # must be run in a workarea.  $bname and patch-queue/$bname
@@ -365,27 +457,26 @@ sub gbp_pq_export ($$$) {
 }
 
 
-# xxx allow merge resolution separately from laundering, before git merge
-#
-# 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)
+# MERGE-TODO allow merge resolution separately from laundering, before git merge
 
 # later/rework?
 #  use git-format-patch?
 #  our own patch identification algorithm?
 #  this is an alternative strategy
 
-sub merge_failed ($$) {
-    my ($wrecknotes, $emsg) = @_;
+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";
@@ -394,8 +485,12 @@ sub merge_failed ($$) {
     push @m, "Wreckage left in $wrecknoteprefix/*.";
 
     push @m, "See git-debrebase(1) section FAILED MERGES for suggestions.";
-    # ^ xxx this section does not yet exist
-    fail join '', map { "$_\n" } @m;
+
+    # 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 ($$$) {
@@ -405,6 +500,19 @@ sub mwrecknote ($$$) {
     $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}
@@ -429,11 +537,14 @@ sub merge_series ($$$;@) {
     # $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 { &mwrecknote($wrecknotes, @_); };
 
-    local $workarea = fresh_playground "$playprefix/merge";
+    my $attempt_cmd = sub { &merge_attempt_cmd($wrecknotes, @_); };
+
+    local $workarea;
+    fresh_workarea "merge";
     my $seriesfile = "debian/patches/series";
     in_workarea sub {
        playtree_setup();
@@ -492,11 +603,8 @@ sub merge_series ($$$;@) {
        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
@@ -569,17 +677,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 qw(gbp pq import);
+       runcmd @git, qw(checkout -q -b mergec), $merged_pq;
+
+       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";
@@ -593,7 +716,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;
 
@@ -603,7 +726,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;
@@ -868,7 +991,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) {
@@ -878,7 +1000,7 @@ sub classify ($) {
        return $unknown->("octopus merge");
     }
 
-    if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) {
+    if (!$opt_merges) {
        return $unknown->("general two-parent merge");
     }
 
@@ -1199,7 +1321,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;
@@ -1331,8 +1453,9 @@ sub walk ($;$$$) {
            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);
@@ -1386,11 +1509,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();
@@ -1402,7 +1520,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)) {
@@ -1416,7 +1539,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') {
@@ -1426,7 +1549,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);
@@ -1437,15 +1560,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:
@@ -1482,27 +1613,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;
             }
@@ -1537,7 +1687,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
@@ -1596,11 +1746,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
@@ -1742,8 +1887,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;
@@ -1756,7 +1900,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";
 }
 
@@ -2140,7 +2284,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;
@@ -2164,19 +2311,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 ($) {
@@ -2232,6 +2392,36 @@ 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 begin_convert_from () {
+    my $head = get_head();
+    return ($head, undef);
+}
+
+sub complete_convert_from ($$$$) {
+    my ($old_head, $new_head, $gi, $mrest) = @_;
+    ffq_check $new_head;
+    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;
@@ -2246,7 +2436,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) {
@@ -2279,6 +2469,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);
@@ -2299,19 +2491,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 <<END;
+Cannot confirm dgit view: $@
+Failed to stitch in dgit view (see messages above).
+dgit --overwrite will be needed on the first dgit push after conversion.
+END
     }
 
     snags_maybe_bail_early();
@@ -2352,9 +2550,10 @@ END
        }
     };
 
-    ffq_check $work;
-    snags_maybe_bail();
-    update_head_checkout $old_head, $work, 'convert-from-gbp';
+    complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp';
+    print <<END or die $!;
+git-debrebase: converted from patched-unapplied (gbp) branch format, OK
+END
 }
 
 sub cmd_convert_to_gbp () {
@@ -2411,7 +2610,7 @@ sub cmd_convert_from_dgit_view () {
                         };
     }
 
-    my $head = get_head();
+    my ($head, $gdrlastinfo) = begin_convert_from();
 
     if (!$always) {
        my $troubles = 0;
@@ -2429,6 +2628,8 @@ END
        }
     }
 
+    check_series_has_all_patches $head;
+
     snags_maybe_bail_early();
 
     my $version = upstreamversion $clogp->{Version};
@@ -2565,12 +2766,50 @@ 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_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;
@@ -2628,6 +2867,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"