X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=git-debrebase;h=3de0aa9f1c1f62c569634e832b861e0f0dba0fc1;hb=f7e37ea9f83b46c5efa4152b36c6cc0f4b91fadd;hp=46ea06af925394634e08eab9a16af02e215709fa;hpb=b5bf8a0f318806562b3089ce8a84d864ee2b3f0f;p=dgit.git
diff --git a/git-debrebase b/git-debrebase
index 46ea06af..3de0aa9f 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -18,6 +18,9 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
+END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
+use Debian::Dgit::ExitStatus;
+
use strict;
use Debian::Dgit qw(:DEFAULT :playground);
@@ -39,7 +42,7 @@ our $us = qw(git-debrebase);
sub badusage ($) {
my ($m) = @_;
print STDERR "bad usage: $m\n";
- exit 12;
+ finish 8;
}
sub cfg ($;$) {
@@ -99,12 +102,20 @@ sub fresh_workarea () {
in_workarea sub { playtree_setup };
}
+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' unless all_snags_summarised();
+
my @upd_cmd = (@git, qw(update-ref --stdin -m), "debrebase: $mrest");
debugcmd '>|', @upd_cmd;
open U, "|-", @upd_cmd or die $!;
@@ -227,10 +238,8 @@ sub make_commit ($$) {
}
our @snag_force_opts;
-our $snags_forced;
-our $snags_tripped;
-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";
@@ -240,7 +249,13 @@ 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 () {
+ return if all_snags_summarised();
if ($snags_forced) {
printf STDERR
"%s: snags: %d overriden by individual -f options\n",
@@ -257,6 +272,7 @@ sub snags_maybe_bail () {
$us, $snags_tripped;
}
}
+ $snags_summarised = $snags_forced + $snags_tripped;
}
sub any_snags () {
return $snags_forced || $snags_tripped;
@@ -417,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");
@@ -505,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
@@ -519,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.
@@ -528,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;
@@ -560,7 +597,7 @@ sub keycommits ($;$$$) {
$breakwater = undef;
} elsif ($ty eq 'Mixed') {
$x->($unclean, 'mixed',
- 'found mixed upstream/packaging commit ($head)');
+ "found mixed upstream/packaging commit ($head)");
$clogonly = undef;
$breakwater = undef;
} elsif ($ty eq 'Pseudomerge' or
@@ -570,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};
}
@@ -901,6 +938,7 @@ sub do_launder_head ($) {
my $old = get_head();
record_ffq_auto();
my ($tip,$breakwater) = walk $old;
+ snags_maybe_bail();
update_head_postlaunder $old, $tip, $reflogmsg;
return ($tip,$breakwater);
}
@@ -935,19 +973,8 @@ sub cmd_analyse () {
}
sub ffq_prev_branchinfo () {
- # => ('status', "message", [$current, $ffq_prev, $gdrlast])
- # 'status' may be
- # branch message is undef
- # weird-symref } no $current,
- # notbranch } no $ffq_prev
my $current = git_get_symref();
- return ('detached', 'detached HEAD') unless defined $current;
- 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, $gdrlast);
+ return gdr_ffq_prev_branchinfo($current);
}
sub record_ffq_prev_deferred () {
@@ -1075,6 +1102,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]",
@@ -1083,8 +1112,8 @@ sub stitch ($$$$$) {
update_head $old_head, $new_head, "stitch: $prose";
}
-sub do_stitch ($) {
- my ($prose) = @_;
+sub do_stitch ($;$) {
+ my ($prose, $unclean) = @_;
my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
if (!$ffq_prev_commitish) {
@@ -1093,7 +1122,8 @@ sub do_stitch ($) {
}
my $dangling_head = get_head();
- keycommits $dangling_head, \&snag, \&snag, \&snag;
+ keycommits $dangling_head, $unclean,$unclean,$unclean;
+ snags_maybe_bail();
stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose);
}
@@ -1110,7 +1140,23 @@ sub cmd_new_upstream_v0 () {
my $new_version = (new Dpkg::Version scalar(shift @ARGV), check => 1);
my $new_upstream_version = $new_version->version();
- my $new_upstream = git_rev_parse (shift @ARGV // 'upstream');
+ my $new_upstream = shift @ARGV;
+ if (!defined $new_upstream) {
+ my @tried;
+ # todo: at some point maybe use git-deborig to do this
+ foreach my $tagpfx ('', 'v', 'upstream/') {
+ my $tag = $tagpfx.(dep14_version_mangle $new_upstream_version);
+ $new_upstream = git_get_ref "refs/tags/$tag";
+ last if length $new_upstream;
+ push @tried, $tag;
+ }
+ if (!length $new_upstream) {
+ fail "Could not determine appropriate upstream commitish.\n".
+ " (Tried these tags: @tried)\n".
+ " Check version, and specify upstream commitish explicitly.";
+ }
+ }
+ $new_upstream = git_rev_parse $new_upstream;
record_ffq_auto();
@@ -1165,13 +1211,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',
@@ -1312,11 +1374,92 @@ sub cmd_breakwater () {
print "$bw\n" or die $!;
}
+sub cmd_status () {
+ badusage "no arguments allowed" if @ARGV;
+
+ # todo: gdr status should print divergence info
+ # todo: gdr status should print upstream component(s) info
+ # todo: gdr should leave/maintain some refs with this kind of info ?
+
+ 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");
badusage "no arguments allowed" if @ARGV;
- do_stitch($prose);
+ do_stitch $prose, 0;
}
sub cmd_prepush () { cmd_stitch(); }
@@ -1339,6 +1482,61 @@ sub cmd_conclude () {
do_stitch 'quick';
}
+sub make_patches_staged ($) {
+ my ($head) = @_;
+ # Produces the patches that would result from $head if it were
+ # laundered.
+ my ($secret_head, $secret_bw, $last_anchor) = walk $head;
+ fresh_workarea();
+ in_workarea sub {
+ runcmd @git, qw(checkout -q -b bw), $secret_bw;
+ runcmd @git, qw(checkout -q -b patch-queue/bw), $secret_head;
+ runcmd qw(gbp pq export);
+ runcmd @git, qw(add debian/patches);
+ };
+}
+
+sub make_patches ($) {
+ my ($head) = @_;
+ keycommits $head, 0, \&snag;
+ make_patches_staged $head;
+ my $out;
+ in_workarea sub {
+ my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/);
+ runcmd @git, qw(read-tree), $head;
+ read_tree_subdir 'debian/patches', $ptree;
+ $out = make_commit [$head], [
+ 'Commit patch queue (exported by git-debrebase)',
+ '[git-debrebase: export and commit patches]',
+ ];
+ };
+ 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;
+ 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;
+ }
+}
+
sub cmd_convert_from_gbp () {
badusage "needs 1 optional argument, the upstream git rev"
unless @ARGV<=1;
@@ -1412,14 +1610,10 @@ sub cmd_convert_to_gbp () {
badusage "no arguments allowed" if @ARGV;
my $head = get_head();
my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
- my ($anchor, $bw) = keycommits $head, 0;
- fresh_workarea();
+ keycommits $head, 0;
my $out;
+ make_patches_staged $head;
in_workarea sub {
- runcmd @git, qw(checkout -q -b bw), $bw;
- runcmd @git, qw(checkout -q -b patch-queue/bw), $head;
- runcmd qw(gbp pq export);
- runcmd @git, qw(add debian/patches);
$out = make_commit ['HEAD'], [
'Commit patch queue (converted from git-debrebase format)',
'[git-debrebase convert-to-gbp: commit patches]',
@@ -1429,6 +1623,7 @@ sub cmd_convert_to_gbp () {
push @deferred_updates, "delete $ffq";
push @deferred_updates, "delete $gdrlast";
}
+ snags_maybe_bail();
update_head_checkout $head, $out, "convert to gbp (v0)";
print <();
}
+
+finish 0;