X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=e5cafd1c4850a7192fe21e06851931963eb12b26;hp=ad501d8a9f3f2d59678af0cd567b162380ce14a7;hb=ca261d36408442d8f3beeac12434af95810b1e32;hpb=a02cbb3c36fa4dc9b073d9494f7b4cedb54f1f08

diff --git a/git-debrebase b/git-debrebase
index ad501d8a..e5cafd1c 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -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");
@@ -515,13 +538,13 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-sub keycommits ($;$$$) {
-    my ($head, $furniture, $unclean, $trouble) = @_;
+sub keycommits ($;$$$$) {
+    my ($head, $furniture, $unclean, $trouble, $fatal) = @_;
     # => ($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
@@ -529,6 +552,8 @@ sub keycommits ($;$$$) {
     # $trouble is for things whnich prevent the return of
     #   anchor and breakwater information; if that is ignored,
     #   then keycommits returns (undef, undef) instead.
+    # $fatal is for unprocessable commits, and should normally cause
+    #    a failure.  If ignored, agaion, (undef, undef) is returned.
     #
     # If a callback is undef, fail is called instead.
     # If a callback is defined but false, the situation is ignored.
@@ -538,15 +563,17 @@ sub keycommits ($;$$$) {
 
     my ($anchor, $breakwater);
     my $clogonly;
+    my $cl;
+    $fatal //= sub { fail $_[2]; };
     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;
@@ -580,12 +607,12 @@ sub keycommits ($;$$$) {
 	} elsif ($ty eq 'DgitImportUnpatched') {
 	    $x->($trouble, 'dgitimport',
 		 "found dgit dsc import ($head)");
-	    $breakwater = undef;
-	    $anchor = undef;
-	    no warnings qw(exiting);
-	    last;
+	    return (undef,undef);
 	} else {
-	    fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
+	    $x->($fatal, 'unprocessable',
+		 "found unprocessable commit, cannot cope: $head; $cl->{Why}"
+		);
+	    return (undef,undef);
 	}
 	$head = $cl->{Parents}[0]{CommitId};
     }
@@ -1086,6 +1113,8 @@ sub stitch ($$$$$) {
 	}
     }
     fresh_workarea();
+    # We make pseudomerges with L as the contributing parent.
+    # This makes git rev-list --first-parent work properly.
     my $new_head = make_commit [ $old_head, $ffq_prev ], [
 	'Declare fast forward / record previous work',
         "[git-debrebase pseudomerge: $prose]",
@@ -1177,13 +1206,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',
@@ -1324,6 +1369,83 @@ sub cmd_breakwater () {
     print "$bw\n" or die $!;
 }
 
+sub cmd_status () {
+    badusage "no arguments allowed" if @ARGV;
+
+    my $oldest = [ 0 ];
+    my $newest;
+    my $note = sub {
+	my ($badness, $ourmsg, $snagname, $kcmsg, $cl) = @_;
+	if ($oldest->[0] < $badness) {
+	    $oldest = $newest = undef;
+	}
+	$oldest = \@_; # we're walking backwards
+	$newest //= \@_;
+    };
+    my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'),
+	sub { $note->(1, 'branch contains furniture (not laundered)', @_); },
+	sub { $note->(2, 'branch is unlaundered', @_); },
+	sub { $note->(3, 'branch needs laundering', @_); },
+	sub { $note->(4, 'branch not in git-debrebase form', @_); };
+
+    my $prcommitinfo = sub {
+	my ($cid) = @_;
+	flush STDOUT or die $!;
+	runcmd @git, qw(--no-pager log -n1),
+	    '--pretty=format:    %h %s%n',
+	    $cid;
+    };
+
+    print "current branch contents, in git-debrebase terms:\n";
+    if (!$oldest->[0]) {
+	print "  branch is laundered\n";
+    } else {
+	print "  $oldest->[1]\n";
+	my $printed = '';
+	foreach my $info ($oldest, $newest) {
+	    my $cid = $info->[4]{CommitId};
+	    next if $cid eq $printed;
+	    $printed = $cid;
+	    print "  $info->[3]\n";
+	    $prcommitinfo->($cid);
+	}
+    }
+
+    my $prab = sub {
+	my ($cid, $what) = @_;
+	if (!defined $cid) {
+	    print "  $what is not well-defined\n";
+	} else {
+	    print "  $what\n";
+	    $prcommitinfo->($cid);
+	}
+    };
+    print "key git-debrebase commits:\n";
+    $prab->($anchor, 'anchor');
+    $prab->($bw, 'breakwater');
+
+    my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
+	ffq_prev_branchinfo();
+
+    print "branch and ref status, in git-debrebase terms:\n";
+    if ($ffq_msg) {
+	print "  $ffq_msg\n";
+    } else {
+	$ffq_prev = git_get_ref $ffq_prev;
+	$gdrlast = git_get_ref $gdrlast;
+	if ($ffq_prev) {
+	    print "  unstitched; previous tip was:\n";
+	    $prcommitinfo->($ffq_prev);
+	} elsif (!$gdrlast) {
+	    print "  stitched? (no record of git-debrebase work)\n";
+	} elsif (is_fast_fwd $gdrlast, 'HEAD') {
+	    print "  stitched\n";
+	} else {
+	    print "  not git-debrebase (diverged since last stitch)\n"
+	}
+    }
+}
+
 sub cmd_stitch () {
     my $prose = 'stitch';
     GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
@@ -1379,28 +1501,31 @@ sub make_patches ($) {
             '[git-debrebase: export and commit patches]',
         ];
     };
-    my $d = get_differs $head, $out;
-    if ($d == 0) {
-	return undef; # nothing to do
-    } elsif ($d == D_PAT_ADD) {
-	return $out; # OK
-    } else {
-	fail "Patch export produced patch amendments".
-	    " (abandoned output commit $out).".
-	    "  Try laundering first.";
-    }
+    return $out;
 }
 
 sub cmd_make_patches () {
+    my $opt_quiet_would_amend;
+    GetOptions('quiet-would-amend!', \$opt_quiet_would_amend)
+	or die badusage("bad options to make-patches");
     badusage "no arguments allowed" if @ARGV;
     my $old_head = get_head();
     my $new = make_patches $old_head;
-    snags_maybe_bail();
-    if (!$new) {
+    my $d = get_differs $old_head, $new;
+    if ($d == 0) {
 	fail "No (more) patches to export." unless $opt_noop_ok;
 	return;
+    } elsif ($d == D_PAT_ADD) {
+	snags_maybe_bail();
+	update_head_checkout $old_head, $new, 'make-patches';
+    } else {
+	print STDERR failmsg
+	    "Patch export produced patch amendments".
+	    " (abandoned output commit $new).".
+	    "  Try laundering first."
+	    unless $opt_quiet_would_amend;
+	finish 7;
     }
-    update_head_checkout $old_head, $new, 'make-patches';
 }
 
 sub cmd_convert_from_gbp () {