chiark / gitweb /
git-debrebase: convert-to-gbp: Handle no-patches case better
[dgit.git] / git-debrebase
index 894bad5d227b8e0adcbb47843ad58af2bd4ac800..a67008f7ed4039d083eb59fe522a5756a133d5f2 100755 (executable)
@@ -50,11 +50,9 @@ usages:
 See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit).
 END
 
-our ($opt_force, $opt_careful, $opt_noop_ok, @opt_anchors);
+our ($opt_force, $opt_noop_ok, $opt_merges, @opt_anchors);
 our ($opt_defaultcmd_interactive);
 
-$opt_careful = 0;
-
 our $us = qw(git-debrebase);
 
 our $wrecknoteprefix = 'refs/debrebase/wreckage';
@@ -183,23 +181,34 @@ sub run_deferred_updates ($) {
     @deferred_update_messages = ();
 }
 
-sub get_tree ($) {
+sub get_tree ($;$$) {
     # tree object name => ([ $name, $info ], ...)
     # where $name is the sort key, ie has / at end for subtrees
     # $info is the LHS from git-ls-tree (<mode> <type> <hash>)
-    # will crash if $x does not exist, so don't do that;
+    # without $precheck, will crash if $x does not exist, so don't do that;
     # instead pass '' to get ().
-    my ($x) = @_;
+    my ($x, $precheck, $recurse) = @_;
 
     return () if !length $x;
 
+    if ($precheck) {
+       my ($type, $dummy) = git_cat_file $x, [qw(tree missing)];
+       return () if $type eq 'missing';
+    }
+
+    $recurse = !!$recurse;
+
+    confess "get_tree needs object not $x ?" unless $x =~ m{^[0-9a-f]+\:};
+
     our (@get_tree_memo, %get_tree_memo);
-    my $memo = $get_tree_memo{$x};
+    my $memo = $get_tree_memo{$recurse,$x};
     return @$memo if $memo;
 
     local $Debian::Dgit::debugcmd_when_debuglevel = 3;
     my @l;
-    my @cmd = (qw(git ls-tree -z --full-tree --), $x);
+    my @cmd = (qw(git ls-tree -z --full-tree));
+    push @cmd, qw(-r) if $recurse;
+    push @cmd, qw(--), $x;
     my $o = cmdoutput @cmd;
     $o =~ s/\0$//s;
     my $last = '';
@@ -209,7 +218,7 @@ sub get_tree ($) {
        push @l, [ $n, $i ];
        confess "$x need $last < $n ?" unless $last lt $n;
     }
-    $get_tree_memo{$x} = \@l;
+    $get_tree_memo{$recurse,$x} = \@l;
     push @get_tree_memo, $x;
     if (@get_tree_memo > 10) {
        delete $get_tree_memo{ shift @get_tree_memo };
@@ -218,15 +227,18 @@ sub get_tree ($) {
 }
 
 sub trees_diff_walk ($$$;$) {
-    # trees_diff_walk [$all,] $x, $y, sub {... }
-    # calls sub->($name, $ix, $iy) for each difference (with $all, each name)
+    # trees_diff_walk [{..opts...},] $x, $y, sub {... }
+    # calls sub->($name, $ix, $iy) for each difference
     # $x and $y are as for get_tree
     # where $name, $ix, $iy are $name and $info from get_tree
-    my $all = shift @_ if @_>=4;
+    # opts are   all       call even for names same in both
+    #            recurse   call even for names same in both
+    my $opts = shift @_ if @_>=4;
     my ($x,$y,$call) = @_;
+    my $all = $opts->{all};
     return if !$all and $x eq $y;
-    my @x = get_tree $x;
-    my @y = get_tree $y;
+    my @x = get_tree $x, 0, $opts->{recurse};
+    my @y = get_tree $y, 0, $opts->{recurse};
     printdebug "trees_diff_walk(..$x,$y..) ".Dumper(\@x,\@y)
        if $debuglevel >= 3;
     while (@x || @y) {
@@ -298,13 +310,16 @@ sub get_differs ($$) {
 
            my $xp = $ix && "$xd/patches";
            my $yp = $iy && "$yd/patches";
-           trees_diff_walk $xp, $yp, sub {
+           trees_diff_walk { recurse=>1 }, $xp, $yp, sub {
                my ($n,$ix,$iy) = @_;
 
                # analyse difference in debian/patches
 
                my $ok;
-               if ($n !~ m/\.series$/s && !$ix && $plain->($iy)) {
+               if ($n =~ m{/$}s) {
+                   # we are recursing; directories may appear and disappear
+                   $ok = 1;
+               } elsif ($n !~ m/\.series$/s && !$ix && $plain->($iy)) {
                    $ok = 1;
                } elsif ($n eq 'series' && $plain->($ix) && $plain->($iy)) {
                    my $x_s = (git_cat_file "$xp/series", 'blob');
@@ -421,11 +436,65 @@ sub any_snags () {
     return $snags_forced || $snags_tripped;
 }
 
+sub ffq_prev_branchinfo () {
+    my $current = git_get_symref();
+    return gdr_ffq_prev_branchinfo($current);
+}
+
+sub record_gdrlast ($$;$) {
+    my ($gdrlast, $newvalue, $oldvalue) = @_;
+    $oldvalue ||= $git_null_obj;
+    push @deferred_updates, "update $gdrlast $newvalue $oldvalue";
+}
+
+sub fail_unprocessable ($) {
+    my ($msg) = @_;
+    changedir $maindir;
+    my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo();
+
+    my $mangled = <<END;
+Branch/history seems mangled - no longer in gdr format.
+See ILLEGAL OPERATIONS in git-debrebase(5).
+END
+    chomp $mangled;
+
+    if (defined $ffqm) {
+       fail <<END;
+$msg
+Is this meant to be a gdr branch?  $ffqm
+END
+    } elsif (git_get_ref $ffq_prev) {
+       fail <<END;
+$msg
+$mangled
+Consider git-debrebase scrap, to throw away your recent work.
+END
+    } elsif (!git_get_ref $gdrlast) {
+       fail <<END;
+$msg
+Branch does not seem to be meant to be a git-debrebase branch?
+Wrong branch, or maybe you needed git-debrebase convert-from-*.
+END
+    } elsif (is_fast_fwd $gdrlast, git_rev_parse 'HEAD') {
+       fail <<END;
+$msg
+$mangled
+END
+    } else {
+       fail <<END;
+$msg
+Branch/history mangled, and diverged since last git-debrebase.
+Maybe you reset to, or rebased from, somewhere inappropriate.
+END
+    }
+};
+
 sub gbp_pq_export ($$$) {
     my ($bname, $base, $tip) = @_;
     # must be run in a workarea.  $bname and patch-queue/$bname
     # ought not to exist.  Leaves you on patch-queue/$bname with
     # the patches staged but not committed.
+    # returns 1 if there were any patches
     printdebug "gbp_pq_export $bname $base $tip\n";
     runcmd @git, qw(checkout -q -b), $bname, $base;
     runcmd @git, qw(checkout -q -b), "patch-queue/$bname", $tip;
@@ -435,15 +504,13 @@ sub gbp_pq_export ($$$) {
        { local ($!,$?); copy('../gbp-pq-err', \*STDERR); }
        failedcmd @gbp_cmd;
     }
-    runcmd @git, qw(add -f debian/patches) if stat_exists 'debian/patches';
+    return 0 unless stat_exists 'debian/patches';
+    runcmd @git, qw(add -f debian/patches);
+    return 1;
 }
 
 
-# xxx allow merge resolution separately from laundering, before git merge
-#
-# xxx general gdr docs highlight forbidden things
-# xxx general gdr docs list allowable things ?
-# xxx general gdr docs explicitly forbid some rebase
+# MERGE-TODO allow merge resolution separately from laundering, before git merge
 
 # later/rework?
 #  use git-format-patch?
@@ -680,6 +747,8 @@ sub merge_series_patchqueue_convert ($$$) {
        runcmd @git, qw(checkout -q -b mergec), $merged_pq;
 
        merge_attempt_cmd($wrecknotes, qw(gbp pq import));
+       # MERGE-TODO consider git-format-patch etc. instead,
+       # since gbp pq doesn't always round-trip :-/
 
        # OK now we are on patch-queue/merge, and we need to rebase
        # onto the intended parent and drop the patches from each one
@@ -975,7 +1044,6 @@ sub classify ($) {
 
     if (@p == 2 and
        $r->{Msg} =~ m{^\[git-debrebase merged-breakwater.*\]$}m) {
-       # xxx ^ metadata tag needs adding to (5)
        return $classify->("MergedBreakwaters");
     }
     if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) {
@@ -985,7 +1053,7 @@ sub classify ($) {
        return $unknown->("octopus merge");
     }
 
-    if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) {
+    if (!$opt_merges) {
        return $unknown->("general two-parent merge");
     }
 
@@ -1039,7 +1107,7 @@ sub keycommits ($;$$$$$) {
     my $clogonly;
     my $cl;
     my $found_pm;
-    $fatal //= sub { fail $_[1]; };
+    $fatal //= sub { fail_unprocessable $_[1]; };
     my $x = sub {
        my ($cb, $tagsfx, $mainwhy, $xwhy) = @_;
        my $why = $mainwhy.$xwhy;
@@ -1136,8 +1204,8 @@ sub walk ($;$$$) {
        my ($prose, $info) = @_;
        my $ms = $cl->{Msg};
        chomp $ms;
-       $info //= '';
-       $ms .= "\n\n[git-debrebase$info: $prose]\n";
+       confess unless defined $info;
+       $ms .= "\n\n[git-debrebase $info: $prose]\n";
        return (Msg => $ms);
     };
     my $rewrite_from_here = sub {
@@ -1164,7 +1232,7 @@ sub walk ($;$$$) {
        if ($nogenerate) {
            return (undef,undef);
        }
-       fail "found unprocessable commit, cannot cope".
+       fail_unprocessable "found unprocessable commit, cannot cope".
            (defined $cl->{Why} ? "; $cl->{Why}:": ':').
            " (commit $cur) (d.".
            (join ' ', map { sprintf "%#x", $_->{Differs} }
@@ -1218,7 +1286,7 @@ sub walk ($;$$$) {
        } elsif ($ty eq 'Mixed') {
            my $queue = sub {
                my ($q, $wh) = @_;
-               my $cls = { %$cl, $xmsg->("split mixed commit: $wh part") };
+               my $cls = { %$cl, $xmsg->("mixed commit: $wh part",'split') };
                push @$q, $cls;
            };
            $queue->(\@brw_cl, "debian");
@@ -1271,12 +1339,12 @@ sub walk ($;$$$) {
                push @brw_cl, {
                    %$cl,
                    SpecialMethod => 'DgitImportDebianUpdate',
-                    $xmsg->("convert dgit import: debian changes")
+                    $xmsg->("debian changes", 'convert dgit import')
                }, {
                    %$cl,
                    SpecialMethod => 'DgitImportUpstreamUpdate',
                     $xmsg->("convert dgit import: upstream update",
-                           " anchor")
+                           "anchor")
                };
                $prline->(" Import");
                $rewrite_from_here->(\@brw_cl);
@@ -1306,7 +1374,7 @@ sub walk ($;$$$) {
            # which was reachable via ffq-prev is no longer findable.
            # This is suboptimal, but if it all works we'll have done
            # the right thing.
-           # xxx we should warn the user in the docs about this
+           # MERGE-TODO we should warn the user in the docs about this
 
            my $ok=1;
            my $best_anchor;
@@ -1469,7 +1537,7 @@ sub walk ($;$$$) {
                 %$cl,
                 SpecialMethod => 'MergeCreateMergedBreakwaters',
                 $xmsg->('constructed from vanilla merge',
-                       ' merged-breakwater'),
+                       'merged-breakwater'),
             };
            push @upp_cl, {
                 %$cl,
@@ -1598,7 +1666,7 @@ sub walk ($;$$$) {
                    printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n";
                }
            }
-           if ($rewriting || $opt_careful) {
+           if ($rewriting) {
                read_tree_upstream $want_upstream, 0, $want_debian;
 
                my $newtree = cmdoutput @git, qw(write-tree);
@@ -1731,11 +1799,6 @@ sub cmd_analyse () {
     STDOUT->error and die $!;
 }
 
-sub ffq_prev_branchinfo () {
-    my $current = git_get_symref();
-    return gdr_ffq_prev_branchinfo($current);
-}
-
 sub ffq_check ($;$$) {
     # calls $ff and/or $notff zero or more times
     # then returns either (status,message) where status is
@@ -1877,8 +1940,7 @@ sub stitch ($$$$$) {
            # ffq-prev is ahead of us, and the only tree changes it has
            # are possibly addition of things in debian/patches/.
            # Just wind forwards rather than making a pointless pseudomerge.
-           push @deferred_updates,
-               "update $gdrlast $ffq_prev_commitish $git_null_obj";
+           record_gdrlast $gdrlast, $ffq_prev_commitish;
            update_head_checkout $old_head, $ffq_prev_commitish,
                "stitch (fast forward)";
            return;
@@ -1891,7 +1953,7 @@ sub stitch ($$$$$) {
        'Declare fast forward / record previous work',
         "[git-debrebase pseudomerge: $prose]",
     ];
-    push @deferred_updates, "update $gdrlast $new_head $git_null_obj";
+    record_gdrlast $gdrlast, $new_head;
     update_head $old_head, $new_head, "stitch: $prose";
 }
 
@@ -2139,7 +2201,7 @@ END
        # Now we have the final new breakwater branch in the index
         $new_bw = make_commit [ $new_bw ],
             [ "Update changelog for new upstream $new_upstream_version",
-              "[git-debrebase: new upstream $new_upstream_version, changelog]",
+              "[git-debrebase changelog: new upstream $new_upstream_version]",
             ];
     };
 
@@ -2336,9 +2398,11 @@ sub make_patches_staged ($) {
     # laundered.
     my ($secret_head, $secret_bw, $last_anchor) = walk $head;
     fresh_workarea();
+    my $any;
     in_workarea sub {
-       gbp_pq_export 'bw', $secret_bw, $secret_head;
+       $any = gbp_pq_export 'bw', $secret_bw, $secret_head;
     };
+    return $any;
 }
 
 sub make_patches ($) {
@@ -2352,7 +2416,7 @@ sub make_patches ($) {
        read_tree_subdir 'debian/patches', $ptree;
        $out = make_commit [$head], [
             'Commit patch queue (exported by git-debrebase)',
-            '[git-debrebase: export and commit patches]',
+            '[git-debrebase make-patches: export and commit patches]',
         ];
     };
     return $out;
@@ -2383,6 +2447,54 @@ sub cmd_make_patches () {
     }
 }
 
+sub check_series_has_all_patches ($) {
+    my ($head) = @_;
+    my $seriesfn = 'debian/patches/series';
+    my ($dummy, $series) = git_cat_file "$head:$seriesfn",
+       [qw(blob missing)];
+    $series //= '';
+    my %series;
+    our $comments_snagged;
+    foreach my $f (grep /\S/, grep {!m/^\s\#/} split /\n/, $series) {
+       if ($f =~ m/^\s*\#/) {
+           snag 'series-comments',
+               "$seriesfn contains comments, which will be discarded"
+               unless $comments_snagged++;
+           next;
+       }
+       fail "patch $f repeated in $seriesfn !" if $series{$f}++;
+    }
+    foreach my $patchfile (get_tree "$head:debian/patches", 1,1) {
+       my ($f,$i) = @$patchfile;
+       next if $series{$f};
+       next if $f eq 'series';
+       snag 'unused-patches', "Unused patch file $f will be discarded";
+    }
+}
+
+sub begin_convert_from () {
+    my $head = get_head();
+    my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo();
+
+    fail "ffq-prev exists, this is already managed by git-debrebase!"
+       if $ffq_prev && git_get_ref $ffq_prev;
+
+    my $gdrlast_obj = $gdrlast && git_get_ref $gdrlast;
+    snag 'already-converted',
+       "ahead of debrebase-last, this is already managed by git-debrebase!"
+       if $gdrlast_obj && is_fast_fwd $gdrlast_obj, $head;
+    return ($head, { LastRef => $gdrlast, LastObj => $gdrlast_obj });
+}
+
+sub complete_convert_from ($$$$) {
+    my ($old_head, $new_head, $gi, $mrest) = @_;
+    ffq_check $new_head;
+    record_gdrlast $gi->{LastRef}, $new_head, $gi->{LastObj}
+       if $gi->{LastRef};
+    snags_maybe_bail();
+    update_head_checkout $old_head, $new_head, $mrest;
+}
+
 sub cmd_convert_from_gbp () {
     badusage "want only 1 optional argument, the upstream git commitish"
        unless @ARGV<=1;
@@ -2397,7 +2509,7 @@ sub cmd_convert_from_gbp () {
     my $upstream =
        resolve_upstream_version($upstream_spec, $upstream_version);
 
-    my $old_head = get_head();
+    my ($old_head, $gdrlastinfo) = begin_convert_from();
 
     my $upsdiff = get_differs $upstream, $old_head;
     if ($upsdiff & D_UPS) {
@@ -2430,6 +2542,8 @@ END
            "upstream ($upstream) contains debian/ directory";
     }
 
+    check_series_has_all_patches $old_head;
+
     my $previous_dgit_view = eval {
        my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2);
        my ($lvsn, $suite);
@@ -2450,19 +2564,25 @@ END
        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{/};
+           unless $mtag =~ m{/};
        is_fast_fwd $mtag, 'HEAD' or
            die "HEAD is not FF from maintainer tag $mtag!";
        my $dtag = "archive/$mtag";
+       git_get_ref "refs/tags/$dtag" or
+           die "dgit view tag $dtag not found\n";
        is_fast_fwd $mtag, $dtag or
-           die "dgit view tag $dtag is not FF from maintainer tag $mtag";
+           die "dgit view tag $dtag is not FF from maintainer tag $mtag\n";
        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";
+       print STDERR <<END;
+Cannot confirm dgit view: $@
+Failed to stitch in dgit view (see messages above).
+dgit --overwrite will be needed on the first dgit push after conversion.
+END
     }
 
     snags_maybe_bail_early();
@@ -2503,24 +2623,30 @@ END
        }
     };
 
-    ffq_check $work;
-    snags_maybe_bail();
-    update_head_checkout $old_head, $work, 'convert-from-gbp';
+    complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp';
+    print <<END or die $!;
+git-debrebase: converted from patched-unapplied (gbp) branch format, OK
+END
 }
 
 sub cmd_convert_to_gbp () {
     badusage "no arguments allowed" if @ARGV;
     my $head = get_head();
     my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
-    keycommits $head, 0;
-    my $out;
-    make_patches_staged $head;
-    in_workarea sub {
-       $out = make_commit ['HEAD'], [
-            'Commit patch queue (converted from git-debrebase format)',
-            '[git-debrebase convert-to-gbp: commit patches]',
-        ];
-    };
+    my ($anchor, $breakwater) = keycommits $head, 0;
+    my $out = $breakwater;
+    my $any = make_patches_staged $head;
+    if ($any) {
+       in_workarea sub {
+           $out = make_commit [$out], [
+               'Commit patch queue (converted from git-debrebase format)',
+               '[git-debrebase convert-to-gbp: commit patches]',
+           ];
+       };
+    } else {
+       # in this case, it can be fast forward
+       $out = $head;
+    }
     if (defined $ffq) {
        push @deferred_updates, "delete $ffq";
        push @deferred_updates, "delete $gdrlast";
@@ -2562,7 +2688,7 @@ sub cmd_convert_from_dgit_view () {
                         };
     }
 
-    my $head = get_head();
+    my ($head, $gdrlastinfo) = begin_convert_from();
 
     if (!$always) {
        my $troubles = 0;
@@ -2580,6 +2706,8 @@ END
        }
     }
 
+    check_series_has_all_patches $head;
+
     snags_maybe_bail_early();
 
     my $version = upstreamversion $clogp->{Version};
@@ -2632,7 +2760,7 @@ Import effective orig tree for upstream version $version
 END
 This includes the contents of the .orig(s), minus any debian/ directory.
 
-[git-debrebase import-from-dgit-view upstream-import-convert: $version]
+[git-debrebase convert-from-dgit-view upstream-import-convert: $version]
 END
                                                    ];
                    push @upstreams, { Commit => $ups_synth,
@@ -2666,7 +2794,7 @@ END
  'git-debrebase convert-from-dgit-view: drop upstream changes from breakwater',
  "Drop upstream changes, and delete debian/patches, as part of converting\n".
  "to git-debrebase format.  Upstream changes will appear as commits.",
- '[git-debrebase convert-from-dgit-view: drop patches from tree]'
+ '[git-debrebase convert-from-dgit-view drop-patches]'
                                           ];
            }
            $work = make_commit [ $work, $u->{Commit} ], [
@@ -2716,15 +2844,25 @@ END
 
     printf STDERR "Yes, will base new branch on %s\n", $result->{Source};
 
-    ffq_check $result->{Result};
-    snags_maybe_bail();
-    update_head_checkout $head, $result->{Result},
+    complete_convert_from $head, $result->{Result}, $gdrlastinfo,
        'convert-from-dgit-view';
 }
 
+sub cmd_forget_was_ever_debrebase () {
+    badusage "forget-was-ever-debrebase takes no further arguments" if @ARGV;
+    my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
+       ffq_prev_branchinfo();
+    fail "Not suitable for recording git-debrebaseness anyway: $ffq_msg"
+       if defined $ffq_msg;
+    push @deferred_updates, "delete $ffq_prev";
+    push @deferred_updates, "delete $gdrlast";
+    snags_maybe_bail();
+    run_deferred_updates "forget-was-ever-debrebase";
+}
+
 sub cmd_record_resolved_merge () {
     badusage "record-resolved-merge takes no further arguments" if @ARGV;
-    # xxx needs documentation
+    # MERGE-TODO needs documentation
     my $new = get_head();
     my $method;
 
@@ -2819,6 +2957,7 @@ getoptions_main
           'anchor=s' => \@opt_anchors,
           '--dgit=s' => \($dgit[0]),
           'force!',
+          'experimental-merge-resolution!', \$opt_merges,
           '-i:s' => sub {
               my ($opt,$val) = @_;
               badusage "git-debrebase: no cuddling to -i for git-rebase"