X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=git-debrebase;h=f2997a3af65fe59b6c52a9efe68f060b5d7acfa9;hb=1c282fc517987649f824fb8241e805c3d3fe68c4;hp=01eb0eb0e95c349fc0f96553286be7e3f9f031d6;hpb=2dbc429b3bc03f9a18f78f8614be74b67e945b8e;p=dgit.git

diff --git a/git-debrebase b/git-debrebase
index 01eb0eb0..f2997a3a 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -494,48 +494,81 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-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) = @_;
+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 $unclean_fproblem_tag;
-	fproblem $unclean_fproblem_tag, $m;
-	$breakwater = undef;
-	no warnings qw(exiting);
-	last;
+	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 ($;$$);
@@ -1191,9 +1224,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 $!;
 }
 
@@ -1210,10 +1249,11 @@ sub cmd_stitch () {
     my $prev = $ffq_prev && git_get_ref $ffq_prev;
     if (!$prev) {
 	fail "No ffq-prev to stitch." unless $opt_noop_ok;
+	return;
     }
     my $old_head = get_head();
 
-    breakwater_of $old_head, 'unclean-stitch';
+    keycommits $old_head, \&fproblem, \&fproblem, \&fproblem;
 
     push @deferred_updates, "delete $ffq_prev $prev";
 
@@ -1310,7 +1350,7 @@ sub cmd_convert_to_gbp () {
     badusage "no arguments allowed" if @ARGV;
     my $head = get_head();
     my (undef, undef, undef, $ffq, $drlast) = ffq_prev_branchinfo();
-    my $bw = breakwater_of $head;
+    my ($anchor, $bw) = keycommits $head, 0;
     fresh_workarea();
     my $out;
     in_workarea sub {