chiark / gitweb /
git-debrebase: keycommits: Pass $cl to callbacks
[dgit.git] / git-debrebase
index f6d379ac81b036e4be6682e1a25b9c24a9b867ef..c0600126ba5df7701c6823330bd6d030c2ddec4f 100755 (executable)
@@ -102,17 +102,19 @@ sub fresh_workarea () {
     in_workarea sub { playtree_setup };
 }
 
-our $snags_forced;
-our $snags_tripped;
-our $snags_checked;
+our $snags_forced = 0;
+our $snags_tripped = 0;
+our $snags_summarised = 0;
 our @deferred_updates;
 our @deferred_update_messages;
 
+sub all_snags_summarised () {
+    $snags_forced + $snags_tripped == $snags_summarised;
+}
 sub run_deferred_updates ($) {
     my ($mrest) = @_;
 
-    confess 'dangerous internal error' if
-       !$snags_checked || $snags_tripped || $snags_forced;
+    confess 'dangerous internal error' unless all_snags_summarised();
 
     my @upd_cmd = (@git, qw(update-ref --stdin -m), "debrebase: $mrest");
     debugcmd '>|', @upd_cmd;
@@ -236,8 +238,8 @@ sub make_commit ($$) {
 }
 
 our @snag_force_opts;
-sub snag ($$) {
-    my ($tag,$msg) = @_;
+sub snag ($$;@) {
+    my ($tag,$msg) = @_; # ignores extra args, for benefit of keycommits
     if (grep { $_ eq $tag } @snag_force_opts) {
        $snags_forced++;
        print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n";
@@ -247,26 +249,30 @@ sub snag ($$) {
     }
 }
 
+# Important: all mainline code must call snags_maybe_bail after
+# any point where snag might be called, but before making changes
+# (eg before any call to run_deferred_updates).  snags_maybe_bail
+# may be called more than once if necessary (but this is not ideal
+# because then the messages about number of snags may be confusing).
 sub snags_maybe_bail () {
-    $snags_checked++;
+    return if all_snags_summarised();
     if ($snags_forced) {
        printf STDERR
            "%s: snags: %d overriden by individual -f options\n",
            $us, $snags_forced;
-       $snags_forced=0;
     }
     if ($snags_tripped) {
        if ($opt_force) {
            printf STDERR
                "%s: snags: %d overriden by global --force\n",
                $us, $snags_tripped;
-           $snags_tripped=0;
        } else {
            fail sprintf
   "%s: snags: %d blockers (you could -f<tag>, or --force)",
                $us, $snags_tripped;
        }
     }
+    $snags_summarised = $snags_forced + $snags_tripped;
 }
 sub any_snags () {
     return $snags_forced || $snags_tripped;
@@ -427,6 +433,23 @@ sub classify ($) {
        # way also there's also an easy rune to look for the upstream
        # patches (--topo-order).
 
+       # Also this makes --first-parent be slightly more likely to
+       # be useful - it makes it provide a linearised breakwater history.
+
+       # Of course one can say somthing like
+       #  gitk -- ':/' ':!/debian'
+       # to get _just_ the commits touching upstream files, and by
+       # the TREESAME logic in git-rev-list this will leave the
+       # breakwater into upstream at the first anchor.  But that
+       # doesn't report debian/ changes at all.
+
+       # Other observations about gitk: by default, gitk seems to
+       # produce output in a different order to git-rev-list.  I
+       # can't seem to find this documented anywhere.  gitk
+       # --date-order DTRT.  But, gitk always seems to put the
+       # parents from left to right, in order, so it's easy to see
+       # which way round a pseudomerge is.
+
        $p[0]{IsOrigin} and $badanchor->("is an origin commit");
        $p[1]{Differs} & ~DS_DEB and
            $badanchor->("upstream files differ from left parent");
@@ -519,9 +542,9 @@ sub keycommits ($;$$$) {
     my ($head, $furniture, $unclean, $trouble) = @_;
     # => ($anchor, $breakwater)
 
-    # $unclean->("unclean-$tagsfx", $msg)
-    # $furniture->("unclean-$tagsfx", $msg)
-    # $dgitimport->("unclean-$tagsfx", $msg)
+    # $unclean->("unclean-$tagsfx", $msg, $cl)
+    # $furniture->("unclean-$tagsfx", $msg, $cl)
+    # $dgitimport->("unclean-$tagsfx", $msg, $cl))
     #   is callled for each situation or commit that
     #   wouldn't be found in a laundered branch
     # $furniture is for furniture commits such as might be found on an
@@ -538,15 +561,16 @@ sub keycommits ($;$$$) {
 
     my ($anchor, $breakwater);
     my $clogonly;
+    my $cl;
     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);
+       $cb->("unclean-$tagsfx", $why, $cl);
     };
     for (;;) {
-       my $cl = classify $head;
+       $cl = classify $head;
        my $ty = $cl->{Type};
        if ($ty eq 'Packaging') {
            $breakwater //= $clogonly;
@@ -1179,13 +1203,29 @@ sub cmd_new_upstream_v0 () {
 
     if ($old_upstream && $old_upstream->{Msg} =~ m{^\[git-debrebase }m) {
        if ($old_upstream->{Msg} =~
- m{^\[git-debrebase upstream-combine \.((?: $extra_orig_namepart_re)+)\:.*\]$}m
+ m{^\[git-debrebase upstream-combine (\.(?: $extra_orig_namepart_re)+)\:.*\]$}m
           ) {
-           my @oldpieces = ('', split / /, $1);
-           my $parentix = -1 + scalar @{ $old_upstream->{Parents} };
-           foreach my $i (0..$#oldpieces) {
-               my $n = $oldpieces[$i];
-               $piece->($n, Old => $old_upstream->{CommitId}.'^'.$parentix);
+           my @oldpieces = (split / /, $1);
+           my $old_n_parents = scalar @{ $old_upstream->{Parents} };
+           if (@oldpieces != $old_n_parents) {
+               snag 'upstream-confusing', sprintf
+                   "previous upstream combine %s".
+                   " mentions %d pieces (each implying one orig commit)".
+                   " but has %d parents",
+                   $old_upstream->{CommitId},
+                   (scalar @oldpieces),
+                   $old_n_parents;
+           } elsif ($oldpieces[0] ne '.') {
+               snag 'upstream-confusing', sprintf
+                   "previous upstream combine %s".
+                   " first piece is not \`.'",
+                   $oldpieces[0];
+           } else {
+               $oldpieces[0] = '';
+               foreach my $i (0..$#oldpieces) {
+                   my $n = $oldpieces[$i];
+                   $piece->($n, Old => $old_upstream->{CommitId}.'^'.($i+1));
+               }
            }
        } else {
            snag 'upstream-confusing',