X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=git-debrebase;h=fb6b79d92a905239f88b8bdeb0dd9c8c1a7f9424;hp=292471de90c33fc2e359a717d5a5ab5907eb56dd;hb=bcc6b2b9ee152cbb679642117ee191a383d359b0;hpb=27aec8c7cfd2cfd315e321d9ac335872665bcfc0

diff --git a/git-debrebase b/git-debrebase
index 292471de..fb6b79d9 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -41,6 +41,8 @@ our ($opt_defaultcmd_interactive);
 
 our $us = qw(git-debrebase);
 
+$|=1;
+
 sub badusage ($) {
     my ($m) = @_;
     print STDERR "bad usage: $m\n";
@@ -270,12 +272,17 @@ sub snags_maybe_bail () {
 		$us, $snags_tripped;
 	} else {
 	    fail sprintf
-  "%s: snags: %d blockers (you could -f<tag>, or --force)",
+  "%s: snags: %d blocker(s) (you could -f<tag>, 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;
 }
@@ -980,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;
 
@@ -1024,14 +1034,14 @@ sub record_ffq_prev_deferred () {
 	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");
 	}
     };
 
@@ -1056,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();
 
@@ -1140,7 +1169,11 @@ sub cmd_new_upstream () {
     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;
@@ -1389,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)', @_); },
@@ -1414,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);
 	}
     }
@@ -1465,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;
 }
@@ -1529,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;
@@ -1710,7 +1748,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;