chiark / gitweb /
git-debrebase: break out stitch() (nfc)
[dgit.git] / git-debrebase
index 9d87e76760ce866c717e0962fdec78868652bc4f..171324671faed440b06338d41208b3eeda52e47b 100755 (executable)
@@ -494,41 +494,81 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-sub breakwater_of ($) {
-    my ($head) = @_; # must be laundered
-    my $breakwater;
-    my $unclean = sub {
-       my ($why) = @_;
-       fail "branch needs laundering (run git-debrebase): $why";
+sub keycommits ($;$$$) {
+    my ($head, $furniture, $unclean, $trouble) = @_;
+    # => ($anchor, $breakwater)
+
+    # $unclean->("unclean-$tagsfx", $msg)
+    # $furniture->("unclean-$tagsfx", $msg)
+    # $dgitimport->("unclean-$tagsfx", $msg)
+    #   is callled for each situation or commit that
+    #   wouldn't be found in a laundered branch
+    # $furniture is forfurniture commits such as might be found on an
+    #   interchange branch (pseudomerge, d/patches, changelog)
+    # $trouble is for things whnich prevent the return of
+    #   anchor and breakwater information; if that is ignored,
+    #   then keycommits returns (undef, undef) instead.
+    #
+    # If a callback is undef, fail is called instead.
+    # If a callback is defined but false, the situation is ignored.
+    # Callbacks may say:
+    #   no warnings qw(exiting); last;
+    # if the answer is no longer wanted.
+
+    my ($anchor, $breakwater);
+    my $clogonly;
+    my $x = sub {
+       my ($cb, $tagsfx, $why) = @_;
+       my $m = "branch needs laundering (run git-debrebase): $why";
+       fail $m unless defined $cb;
+       return unless $cb;
+       $cb->("unclean-$tagsfx", $why);
     };
     for (;;) {
        my $cl = classify $head;
        my $ty = $cl->{Type};
-       if ($ty eq 'Packaging' or
-           $ty eq 'Changelog') {
+       if ($ty eq 'Packaging') {
+           $breakwater //= $clogonly;
            $breakwater //= $head;
+       } elsif ($ty eq 'Changelog') {
+           # this is going to count as the tip of the breakwater
+           # only if it has no upstream stuff before it
+           $clogonly //= $head;
        } elsif ($ty eq 'Anchor' or
                 $ty eq 'TreatAsAnchor' or
                 $ty eq 'BreakwaterStart') {
+           $anchor = $head;
+           $breakwater //= $clogonly;
            $breakwater //= $head;
            last;
        } elsif ($ty eq 'Upstream') {
-           $unclean->("packaging change ($breakwater)".
                     " follows upstream change (eg $head)")
+           $x->($unclean, 'ordering',
"packaging change ($breakwater) follows upstream change (eg $head)")
                if defined $breakwater;
+           $clogonly = undef;
+           $breakwater = undef;
        } elsif ($ty eq 'Mixed') {
-           $unclean->('found mixed upstream/packaging commit ($head)');
+           $x->($unclean, 'mixed',
+                'found mixed upstream/packaging commit ($head)');
+           $clogonly = undef;
+           $breakwater = undef;
        } elsif ($ty eq 'Pseudomerge' or
                 $ty eq 'AddPatches') {
-           $unclean->("found interchange conversion commit ($ty, $head)");
+           $x->($furniture, (lc $ty),
+                "found interchange bureaucracy commit ($ty, $head)");
        } elsif ($ty eq 'DgitImportUnpatched') {
-           $unclean->("found dgit dsc import ($head)");
+           $x->($trouble, 'dgitimport',
+                "found dgit dsc import ($head)");
+           $breakwater = undef;
+           $anchor = undef;
+           no warnings qw(exiting);
+           last;
        } else {
            fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
        }
        $head = $cl->{Parents}[0]{CommitId};
     }
-    return $breakwater;
+    return ($anchor, $breakwater);
 }
 
 sub walk ($;$$);
@@ -877,7 +917,7 @@ sub cmd_analyse () {
 }
 
 sub ffq_prev_branchinfo () {
-    # => ('status', "message", [$current, $ffq_prev])
+    # => ('status', "message", [$current, $ffq_prev, $gdrlast])
     # 'status' may be
     #    branch         message is undef
     #    weird-symref   } no $current,
@@ -887,8 +927,9 @@ sub ffq_prev_branchinfo () {
     return ('weird-symref', 'HEAD symref is not to refs/')
        unless $current =~ m{^refs/};
     my $ffq_prev = "refs/$ffq_refprefix/$'";
+    my $gdrlast = "refs/$gdrlast_refprefix/$'";
     printdebug "ffq_prev_branchinfo branch current $current\n";
-    return ('branch', undef, $current, $ffq_prev);
+    return ('branch', undef, $current, $ffq_prev, $gdrlast);
 }
 
 sub record_ffq_prev_deferred () {
@@ -903,7 +944,8 @@ sub record_ffq_prev_deferred () {
     # if "deferred", will have added something about that to
     #   @deferred_update_messages, and also maybe printed (already)
     #   some messages about ff checks
-    my ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    my ($status, $message, $current, $ffq_prev, $gdrlast)
+       = ffq_prev_branchinfo();
     return ($status, $message) unless $status eq 'branch';
 
     my $currentval = get_head();
@@ -970,6 +1012,7 @@ sub record_ffq_prev_deferred () {
     fproblems_maybe_bail();
 
     push @deferred_updates, "update $ffq_prev $currentval $git_null_obj";
+    push @deferred_updates, "delete $gdrlast";
     push @deferred_update_messages, "Recorded current head for preservation";
     return ('deferred', undef);
 }
@@ -983,6 +1026,33 @@ sub record_ffq_auto () {
     }
 }
 
+sub stitch ($$$$$) {
+    my ($old_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose) = @_;
+
+    push @deferred_updates, "delete $ffq_prev $ffq_prev_commitish";
+
+    if (is_fast_fwd $old_head, $ffq_prev_commitish) {
+       my $differs = get_differs $old_head, $ffq_prev_commitish;
+       unless ($differs & ~D_PAT_ADD) {
+           # 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";
+           update_head_checkout $old_head, $ffq_prev_commitish,
+               "stitch (fast forward)";
+           return;
+       }
+    }
+    fresh_workarea();
+    my $new_head = make_commit [ $old_head, $ffq_prev ], [
+       'Declare fast forward / record previous work',
+        "[git-debrebase pseudomerge: stitch$prose]",
+    ];
+    push @deferred_updates, "update $gdrlast $new_head $git_null_obj";
+    update_head $old_head, $new_head, "stitch";
+}
+
 sub cmd_new_upstream_v0 () {
     # automatically and unconditionally launders before rebasing
     # if rebase --abort is used, laundering has still been done
@@ -1181,9 +1251,15 @@ sub cmd_record_ffq_prev () {
     }
 }
 
+sub cmd_anchor () {
+    badusage "no arguments allowed" if @ARGV;
+    my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
+    print "$bw\n" or die $!;
+}
+
 sub cmd_breakwater () {
     badusage "no arguments allowed" if @ARGV;
-    my $bw = breakwater_of git_rev_parse 'HEAD';
+    my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
     print "$bw\n" or die $!;
 }
 
@@ -1191,34 +1267,22 @@ sub cmd_stitch () {
     my $prose = '';
     GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
     badusage "no arguments allowed" if @ARGV;
-    my ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    my ($status, $message, $current, $ffq_prev, $gdrlast)
+       = ffq_prev_branchinfo();
     if ($status ne 'branch') {
        fproblem $status, "could not check ffq-prev: $message";
        fproblems_maybe_bail();
     }
-    my $prev = $ffq_prev && git_get_ref $ffq_prev;
-    if (!$prev) {
+    my $ffq_prev_commitish = $ffq_prev && git_get_ref $ffq_prev;
+    if (!$ffq_prev_commitish) {
        fail "No ffq-prev to stitch." unless $opt_noop_ok;
+       return;
     }
-    push @deferred_updates, "delete $ffq_prev $prev";
-
     my $old_head = get_head();
-    if (is_fast_fwd $old_head, $prev) {
-       my $differs = get_differs $old_head, $prev;
-       unless ($differs & ~D_PAT_ADD) {
-           # 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.
-           update_head_checkout $old_head, $prev, "stitch (fast forward)";
-           return;
-       }
-    }
-    fresh_workarea();
-    my $new_head = make_commit [ $old_head, $ffq_prev ], [
-       'Declare fast forward / record previous work',
-        "[git-debrebase pseudomerge: stitch$prose]",
-    ];
-    update_head $old_head, $new_head, "stitch";
+
+    keycommits $old_head, \&fproblem, \&fproblem, \&fproblem;
+
+    stitch($old_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose);
 }
 
 sub cmd_convert_from_gbp () {
@@ -1293,8 +1357,8 @@ sub cmd_convert_from_gbp () {
 sub cmd_convert_to_gbp () {
     badusage "no arguments allowed" if @ARGV;
     my $head = get_head();
-    my $ffq = (ffq_prev_branchinfo())[3];
-    my $bw = breakwater_of $head;
+    my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
+    my ($anchor, $bw) = keycommits $head, 0;
     fresh_workarea();
     my $out;
     in_workarea sub {
@@ -1309,6 +1373,7 @@ sub cmd_convert_to_gbp () {
     };
     if (defined $ffq) {
        push @deferred_updates, "delete $ffq";
+       push @deferred_updates, "delete $gdrlast";
     }
     update_head_checkout $head, $out, "convert to gbp (v0)";
     print <<END or die $!;