git-debrebase: test suite: introduce t-dch-commit

[dgit.git] / git-debrebase

diff --git a/git-debrebase b/git-debrebase
index f68dfb1ae2ee674324e03dab36ec0619e95ba5d6..a853c0639c1cf1f0daad4f891e0c3838c1912b87 100755 (executable)
--- a/git-debrebase
+++ b/git-debrebase
@@ -29,6 +29,7 @@
 #    git-debrebase [<options> --] [<git-rebase options...>]
 #    git-debrebase [<options>] analyse
 #    git-debrebase [<options>] launder         # prints breakwater tip etc.
+#    git-debrebase [<options>] stitch [--prose=<for commit message>]
 #    git-debrebase [<options>] downstream-rebase-launder-v0  # experimental
 #
 #    git-debrebase [<options>] gbp2debrebase-v0 \
@@ -832,6 +833,12 @@ sub cmd_launder () {
 
 sub defaultcmd_rebase () {
     my $old = get_head();
+    my ($status, $message) = record_ffq_prev();
+    if ($status eq 'written' || $status eq 'exists') {
+    } else {
+       fproblem $status, "could not record ffq-prev: $message";
+       fproblems_maybe_bail();
+    }
     my ($tip,$breakwater) = walk $old;
     update_head_postlaunder $old, $tip, 'launder for rebase';
     runcmd @git, qw(rebase), @ARGV, $breakwater;
@@ -850,6 +857,20 @@ sub cmd_analyse () {
     STDOUT->error and die $!;
 }
 
+sub ffq_prev_branchinfo () {
+    # => ('status', "message", [$current, $ffq_prev])
+    # '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/$'";
+    return ('branch', undef, $current, $ffq_prev);
+}
+
 sub record_ffq_prev () {
     # => ('status', "message")
     # 'status' may be
@@ -861,11 +882,8 @@ sub record_ffq_prev () {
     # if not ff from some branch we should be ff from, is an fproblem
     # if "written", will have printed something about that to stdout,
     #   and also some messages about ff checks
-    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 ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    return ($status, $message) unless $status eq 'branch';
 
     my $currentval = get_head();
 
@@ -1119,6 +1137,38 @@ sub cmd_record_ffq_prev () {
     }
 }
 
+sub cmd_stitch () {
+    my $prose = '';
+    GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
+    badusage "no arguments allowed" if @ARGV;
+    my ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    if ($status ne 'branch') {
+       fproblem $status, "could not check ffq-prev: $message";
+       fproblems_maybe_bail();
+    }
+    my $prev = $ffq_prev && git_get_ref $ffq_prev;
+    if (!$prev) {
+       fail "No ffq-prev to stitch." unless $opt_noop_ok;
+    }
+    fresh_workarea();
+    my $old_head = get_head();
+    my $new_head = make_commit [ $old_head, $ffq_prev ], [
+       'Declare fast forward / record previous work',
+        "[git-debrebase pseudomerge: stitch$prose]",
+    ];
+    my @upd_cmd = (@git, qw(update-ref --stdin));
+    debugcmd '>|', @upd_cmd;
+    open U, "|-", @upd_cmd or die $!;
+    my $u = <<END;
+update HEAD $new_head $old_head
+delete $ffq_prev $prev
+END
+    printdebug ">= ", $_, "\n" foreach split /\n/, $u;
+    print U $u;
+    printdebug ">\$\n";
+    close U or failedcmd @upd_cmd;
+}
+
 sub cmd_gbp2debrebase () {
     badusage "needs 1 optional argument, the upstream" unless @ARGV<=1;
     my ($upstream_spec) = @ARGV;