git-debrebase: breakwater_of: permit unclean to be an fproblem

[dgit.git] / git-debrebase

diff --git a/git-debrebase b/git-debrebase
index 9d87e76760ce866c717e0962fdec78868652bc4f..f79aef5ff2241478bb98e452fe134d30492208a1 100755 (executable)
--- a/git-debrebase
+++ b/git-debrebase
@@ -494,12 +494,19 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-sub breakwater_of ($) {
-    my ($head) = @_; # must be laundered
+sub breakwater_of ($;$) {
+    my ($head, $unclean_fproblem_tag) = @_;
+    # $head should be laundered; if not, $unclean_fproblem_tag controls:
+    # if falseish, calls fail; otherwise, calls fproblem and returns undef
     my $breakwater;
     my $unclean = sub {
        my ($why) = @_;
-       fail "branch needs laundering (run git-debrebase): $why";
+       my $m = "branch needs laundering (run git-debrebase): $why";
+       fail $m unless $unclean_fproblem_tag;
+       fproblem $unclean_fproblem_tag, $m;
+       $breakwater = undef;
+       no warnings qw(exiting);
+       last;
     };
     for (;;) {
        my $cl = classify $head;
@@ -877,7 +884,7 @@ sub cmd_analyse () {
 }
 
 sub ffq_prev_branchinfo () {
-    # => ('status', "message", [$current, $ffq_prev])
+    # => ('status', "message", [$current, $ffq_prev, $drlast])
     # 'status' may be
     #    branch         message is undef
     #    weird-symref   } no $current,
@@ -887,8 +894,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 $drlast = "refs/$gdrlast_refprefix/$'";
     printdebug "ffq_prev_branchinfo branch current $current\n";
-    return ('branch', undef, $current, $ffq_prev);
+    return ('branch', undef, $current, $ffq_prev, $drlast);
 }
 
 sub record_ffq_prev_deferred () {
@@ -903,7 +911,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, $drlast)
+       = ffq_prev_branchinfo();
     return ($status, $message) unless $status eq 'branch';
 
     my $currentval = get_head();
@@ -970,6 +979,7 @@ sub record_ffq_prev_deferred () {
     fproblems_maybe_bail();
 
     push @deferred_updates, "update $ffq_prev $currentval $git_null_obj";
+    push @deferred_updates, "delete $drlast";
     push @deferred_update_messages, "Recorded current head for preservation";
     return ('deferred', undef);
 }
@@ -1191,7 +1201,8 @@ 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, $drlast)
+       = ffq_prev_branchinfo();
     if ($status ne 'branch') {
        fproblem $status, "could not check ffq-prev: $message";
        fproblems_maybe_bail();
@@ -1209,6 +1220,7 @@ sub cmd_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 $drlast $prev $git_null_obj";
            update_head_checkout $old_head, $prev, "stitch (fast forward)";
            return;
        }
@@ -1218,6 +1230,7 @@ sub cmd_stitch () {
        'Declare fast forward / record previous work',
         "[git-debrebase pseudomerge: stitch$prose]",
     ];
+    push @deferred_updates, "update $drlast $new_head $git_null_obj";
     update_head $old_head, $new_head, "stitch";
 }
 
@@ -1293,7 +1306,7 @@ 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 (undef, undef, undef, $ffq, $drlast) = ffq_prev_branchinfo();
     my $bw = breakwater_of $head;
     fresh_workarea();
     my $out;
@@ -1309,6 +1322,7 @@ sub cmd_convert_to_gbp () {
     };
     if (defined $ffq) {
        push @deferred_updates, "delete $ffq";
+       push @deferred_updates, "delete $drlast";
     }
     update_head_checkout $head, $out, "convert to gbp (v0)";
     print <<END or die $!;