X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=f00222520e9cf2f6d230b6ebd955d5b2c7aac80b;hp=3de0aa9f1c1f62c569634e832b861e0f0dba0fc1;hb=45fad9bad87765ce13511a0ba8f302ba9ddd1cd5;hpb=edc1cd049cfa01e7d6249ea199725d2448858704 diff --git a/git-debrebase b/git-debrebase index 3de0aa9f..f0022252 100755 --- a/git-debrebase +++ b/git-debrebase @@ -19,6 +19,7 @@ # along with this program. If not, see . END { $? = $Debian::Dgit::ExitStatus::desired // -1; }; +use Debian::Dgit::GDR; use Debian::Dgit::ExitStatus; use strict; @@ -33,12 +34,15 @@ use Data::Dumper; use Getopt::Long qw(:config posix_default gnu_compat bundling); use Dpkg::Version; use File::FnMatch qw(:fnmatch); +use File::Copy; our ($opt_force, $opt_noop_ok, @opt_anchors); our ($opt_defaultcmd_interactive); our $us = qw(git-debrebase); +$|=1; + sub badusage ($) { my ($m) = @_; print STDERR "bad usage: $m\n"; @@ -116,7 +120,7 @@ sub run_deferred_updates ($) { confess 'dangerous internal error' unless all_snags_summarised(); - my @upd_cmd = (@git, qw(update-ref --stdin -m), "debrebase: $mrest"); + my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); debugcmd '>|', @upd_cmd; open U, "|-", @upd_cmd or die $!; foreach (@deferred_updates) { @@ -268,12 +272,17 @@ sub snags_maybe_bail () { $us, $snags_tripped; } else { fail sprintf - "%s: snags: %d blockers (you could -f, or --force)", + "%s: snags: %d blocker(s) (you could -f, or --force)", $us, $snags_tripped; } } $snags_summarised = $snags_forced + $snags_tripped; } +sub snags_maybe_bail_early () { + # useful to bail out early without doing a lot of work; + # not a substitute for snags_maybe_bail. + snags_maybe_bail() if $snags_tripped && !$opt_force; +} sub any_snags () { return $snags_forced || $snags_tripped; } @@ -566,11 +575,12 @@ sub keycommits ($;$$$$) { my $cl; $fatal //= sub { fail $_[2]; }; my $x = sub { - my ($cb, $tagsfx, $why) = @_; + my ($cb, $tagsfx, $mainwhy, $xwhy) = @_; + my $why = $mainwhy.$xwhy; my $m = "branch needs laundering (run git-debrebase): $why"; fail $m unless defined $cb; return unless $cb; - $cb->("unclean-$tagsfx", $why, $cl); + $cb->("unclean-$tagsfx", $why, $cl, $mainwhy); }; for (;;) { $cl = classify $head; @@ -591,27 +601,27 @@ sub keycommits ($;$$$$) { last; } elsif ($ty eq 'Upstream') { $x->($unclean, 'ordering', - "packaging change ($breakwater) follows upstream change (eg $head)") + "packaging change ($breakwater) follows upstream change"," (eg $head)") if defined $breakwater; $clogonly = undef; $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 $ty eq 'AddPatches') { $x->($furniture, (lc $ty), - "found interchange bureaucracy commit ($ty, $head)"); + "found interchange bureaucracy commit ($ty)"," ($head)"); } elsif ($ty eq 'DgitImportUnpatched') { $x->($trouble, 'dgitimport', "found dgit dsc import ($head)"); return (undef,undef); } else { $x->($fatal, 'unprocessable', - "found unprocessable commit, cannot cope: $head; $cl->{Why}" - ); + "found unprocessable commit, cannot cope: $cl->{Why}", + " ($head)"); return (undef,undef); } $head = $cl->{Parents}[0]{CommitId}; @@ -977,24 +987,27 @@ sub ffq_prev_branchinfo () { return gdr_ffq_prev_branchinfo($current); } -sub record_ffq_prev_deferred () { - # => ('status', "message") - # 'status' may be - # deferred message is undef +sub ffq_check ($;$$) { + # calls $ff and/or $notff zero or more times + # then returns either (status,message) where status is # exists # detached # weird-symref # notbranch - # if not ff from some branch we should be ff from, is an snag - # if "deferred", will have added something about that to - # @deferred_update_messages, and also maybe printed (already) - # some messages about ff checks + # or (undef,undef, $ffq_prev,$gdrlast) + # $ff and $notff are called like this: + # $ff->("message for stdout\n"); + # $notff->('snag-name', $message); + # normally $currentval should be HEAD + my ($currentval, $ff, $notff) =@_; + + $ff //= sub { print $_[0] or die $!; }; + $notff //= \&snag; + my ($status, $message, $current, $ffq_prev, $gdrlast) = ffq_prev_branchinfo(); return ($status, $message) unless $status eq 'branch'; - my $currentval = get_head(); - my $exists = git_get_ref $ffq_prev; return ('exists',"$ffq_prev already exists") if $exists; @@ -1018,17 +1031,17 @@ sub record_ffq_prev_deferred () { } return if $invert; my $lrval = git_get_ref $lrref; - return unless defined $lrval; + return unless length $lrval; if (is_fast_fwd $lrval, $currentval) { - print "OK, you are ahead of $lrref\n" or die $!; + $ff->("OK, you are ahead of $lrref\n"); $checked{$lrref} = 1; } elsif (is_fast_fwd $currentval, $lrval) { $checked{$lrref} = -1; - snag 'behind', "you are behind $lrref, divergence risk"; + $notff->('behind', "you are behind $lrref, divergence risk"); } else { $checked{$lrref} = -1; - snag 'diverged', "you have diverged from $lrref"; + $notff->('diverged', "you have diverged from $lrref"); } }; @@ -1053,6 +1066,25 @@ sub record_ffq_prev_deferred () { } elsif ($branch =~ m{^master$}) { $check->("refs/remotes/dgit/dgit/sid", 'remote dgit branch for sid'); } + return (undef, undef, $ffq_prev, $gdrlast); +} + +sub record_ffq_prev_deferred () { + # => ('status', "message") + # 'status' may be + # deferred message is undef + # exists + # detached + # weird-symref + # notbranch + # if not ff from some branch we should be ff from, is an snag + # if "deferred", will have added something about that to + # @deferred_update_messages, and also maybe printed (already) + # some messages about ff checks + my $currentval = get_head(); + + my ($status,$message, $ffq_prev,$gdrlast) = ffq_check $currentval; + return ($status,$message) if defined $status; snags_maybe_bail(); @@ -1128,7 +1160,7 @@ sub do_stitch ($;$) { stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose); } -sub cmd_new_upstream_v0 () { +sub cmd_new_upstream () { # automatically and unconditionally launders before rebasing # if rebase --abort is used, laundering has still been done @@ -1137,7 +1169,11 @@ sub cmd_new_upstream_v0 () { badusage "need NEW-VERSION [UPS-COMMITTISH]" unless @ARGV >= 1; # parse args - low commitment - my $new_version = (new Dpkg::Version scalar(shift @ARGV), check => 1); + my $spec_version = shift @ARGV; + my $new_version = (new Dpkg::Version $spec_version, check => 1); + if ($new_version->is_native()) { + $new_version = (new Dpkg::Version "$spec_version-1", check => 1); + } my $new_upstream_version = $new_version->version(); my $new_upstream = shift @ARGV; @@ -1215,11 +1251,13 @@ sub cmd_new_upstream_v0 () { ) { my @oldpieces = (split / /, $1); my $old_n_parents = scalar @{ $old_upstream->{Parents} }; - if (@oldpieces != $old_n_parents) { + if ($old_n_parents != @oldpieces && + $old_n_parents != @oldpieces + 1) { snag 'upstream-confusing', sprintf "previous upstream combine %s". - " mentions %d pieces (each implying one orig commit)". - " but has %d parents", + " mentions %d pieces (each implying one parent)". + " but has %d parents". + " (one per piece plus maybe a previous combine)", $old_upstream->{CommitId}, (scalar @oldpieces), $old_n_parents; @@ -1232,7 +1270,8 @@ sub cmd_new_upstream_v0 () { $oldpieces[0] = ''; foreach my $i (0..$#oldpieces) { my $n = $oldpieces[$i]; - $piece->($n, Old => $old_upstream->{CommitId}.'^'.($i+1)); + my $hat = 1 + $i + ($old_n_parents - @oldpieces); + $piece->($n, Old => $old_upstream->{CommitId}.'^'.$hat); } } } else { @@ -1346,6 +1385,8 @@ END 'launder for new upstream'; my @cmd = (@git, qw(rebase --onto), $new_bw, $old_bw, @ARGV); + local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg + "debrebase new-upstream $new_version: rebase"; runcmd @cmd; # now it's for the user to sort out } @@ -1381,15 +1422,20 @@ sub cmd_status () { # 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 $oldest = { Badness => 0 }; my $newest; my $note = sub { - my ($badness, $ourmsg, $snagname, $kcmsg, $cl) = @_; - if ($oldest->[0] < $badness) { + my ($badness, $ourmsg, $snagname, $dummy, $cl, $kcmsg) = @_; + if ($oldest->{Badness} < $badness) { $oldest = $newest = undef; } - $oldest = \@_; # we're walking backwards - $newest //= \@_; + $oldest = { + Badness => $badness, + CommitId => $cl->{CommitId}, + OurMsg => $ourmsg, + KcMsg => $kcmsg, + }; + $newest //= $oldest; }; my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), sub { $note->(1, 'branch contains furniture (not laundered)', @_); }, @@ -1406,16 +1452,16 @@ sub cmd_status () { }; print "current branch contents, in git-debrebase terms:\n"; - if (!$oldest->[0]) { + if (!$oldest->{Badness}) { print " branch is laundered\n"; } else { - print " $oldest->[1]\n"; + print " $oldest->{OurMsg}\n"; my $printed = ''; foreach my $info ($oldest, $newest) { - my $cid = $info->[4]{CommitId}; + my $cid = $info->{CommitId}; next if $cid eq $printed; $printed = $cid; - print " $info->[3]\n"; + print " $info->{KcMsg}\n"; $prcommitinfo->($cid); } } @@ -1457,7 +1503,7 @@ sub cmd_status () { sub cmd_stitch () { my $prose = 'stitch'; - GetOptions('prose=s', \$prose) or die badusage("bad options to stitch"); + GetOptions('prose=s', \$prose) or badusage("bad options to stitch"); badusage "no arguments allowed" if @ARGV; do_stitch $prose, 0; } @@ -1491,8 +1537,13 @@ sub make_patches_staged ($) { 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); + my @gbp_cmd = (qw(gbp pq export)); + my $r = system shell_cmd 'exec >../gbp-pq-err 2>&1', @gbp_cmd; + if ($r) { + { local ($!,$?); copy('../gbp-pq-err', \*STDERR); } + failedcmd @gbp_cmd; + } + runcmd @git, qw(add -f debian/patches); }; } @@ -1516,7 +1567,7 @@ sub make_patches ($) { 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"); + or badusage("bad options to make-patches"); badusage "no arguments allowed" if @ARGV; my $old_head = get_head(); my $new = make_patches $old_head; @@ -1572,7 +1623,42 @@ sub cmd_convert_from_gbp () { "upstream ($upstream) contains debian/ directory"; } - snags_maybe_bail(); + my $previous_dgit_view = eval { + my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2); + my ($lvsn, $suite); + parsechangelog_loop \@clogcmd, 'debian/changelog', sub { + my ($stz, $desc) = @_; + no warnings qw(exiting); + printdebug 'CHANGELOG ', Dumper($desc, $stz); + next unless $stz->{Date}; + next unless $stz->{Distribution} ne 'UNRELEASED'; + $lvsn = $stz->{Version}; + $suite = $stz->{Distribution}; + last; + }; + die "neither of the first two changelog entries are released\n" + unless defined $lvsn; + print "last finished-looking changelog entry: ($lvsn) $suite\n"; + my $mtag_pat = debiantag_maintview $lvsn, '*'; + my $mtag = cmdoutput @git, qw(describe --always --abbrev=0 --match), + $mtag_pat; + die "could not find suitable maintainer view tag $mtag_pat\n" + unless $mtag_pat =~ m{/}; + is_fast_fwd $mtag, 'HEAD' or + die "HEAD is not FF from maintainer tag $mtag!"; + my $dtag = "archive/$mtag"; + is_fast_fwd $mtag, $dtag or + die "dgit view tag $dtag is not FF from maintainer tag $mtag"; + print "will stitch in dgit view, $dtag\n"; + git_rev_parse $dtag; + }; + if (!$previous_dgit_view) { + $@ =~ s/^\n+//; + chomp $@; + print STDERR "cannot stitch in dgit view: $@\n"; + } + + snags_maybe_bail_early(); my $work; @@ -1601,8 +1687,17 @@ sub cmd_convert_from_gbp () { runcmd @git, qw(reset --quiet --hard patch-queue/gdr-internal); runcmd @git, qw(rebase --quiet --onto), $work, qw(gdr-internal); $work = git_rev_parse 'HEAD'; + + if ($previous_dgit_view) { + $work = make_commit [$work, $previous_dgit_view], [ + 'git-debrebase import: declare ff from dgit archive view', + '[git-debrebase pseudomerge: import-from-gbp]', + ]; + } }; + ffq_check $work; + snags_maybe_bail(); update_head_checkout $old_head, $work, 'convert-from-gbp'; } @@ -1697,7 +1792,7 @@ GetOptions("D+" => \$debuglevel, # approach. '-i=s{0,}' does not work with bundling. push @$opt_defaultcmd_interactive, @ARGV; @ARGV=(); - }) or die badusage "bad options\n"; + }) or badusage "bad options\n"; initdebug('git-debrebase '); enabledebug if $debuglevel;