update debugging functions

[debbugs.git] / Debbugs / Control.pm

diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index e42f2f9055fe8481aa4b94bb6c69663e75bc4de3..80e0c24156687296948ef68ac197f438f4c9d376 100644 (file)
--- a/Debbugs/Control.pm
+++ b/Debbugs/Control.pm
@@ -2075,7 +2075,7 @@ sub set_merged {
            # figure out the problems
            print {$transcript} "Unable to merge bugs because:\n";
            for my $change (@{$disallowed_changes}) {
-               print {$transcript} "$change->{field} of #$change->{bug} is '$change->{orig_value}' not '$change->{text_value}'\n";
+               print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
            }
            if ($attempts > 0) {
                croak "Some bugs were altered while attempting to merge";
@@ -2139,8 +2139,8 @@ sub set_merged {
        $locks += $n_locks;
        %data = %{$data};
        @data = values %data;
-       ($merge_status,$bugs_to_merge) =
-           __calculate_merge_status(\@data,\%data,$param{bug});
+       ($merge_status,$bugs_to_merge) =
+           __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
        ($disallowed_changes,$changes) = 
            __calculate_merge_changes(\@data,$merge_status,\%param);
        $attempts = max(values %bug_changed);
@@ -2191,8 +2191,9 @@ sub set_merged {
 sub __allow_relocking{
     my ($locks,$bugs) = @_;
 
-    for my $bug (@{$bugs}) {
-       my @lockfiles = grep {m{/\Q$bug\E$}} keys %{$locks->{locks}};
+    my @locks = (@{$bugs},'merge');
+    for my $lock (@locks) {
+       my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
        next unless @lockfiles;
        $locks->{relockable}{$lockfiles[0]} = 0;
     }
@@ -2273,8 +2274,8 @@ sub __lock_and_load_merged_bugs{
 
 
 sub __calculate_merge_status{
-    my ($data_a,$data_h,$master_bug,$merge) = @_;
-    my %merge_status;
+    my ($data_a,$data_h,$master_bug,$merge_status) = @_;
+    my %merge_status = %{$merge_status // {}};
     my %merged_bugs;
     my $bugs_to_merge = 0;
     for my $data (@{$data_a}) {
@@ -2292,9 +2293,9 @@ sub __calculate_merge_status{
                $merge_status{$_} = $data->{$_}
            }
        }
-       if (not $merge) {
-           next unless $data->{bug_num} == $master_bug;
-       }
+       if (defined $merge_status) {
+           next unless $data->{bug_num} == $master_bug;
+       }
        $merge_status{tag} = {} if not exists $merge_status{tag};
        for my $tag (split /\s+/, $data->{keywords}) {
            $merge_status{tag}{$tag} = 1;
@@ -2408,11 +2409,12 @@ sub __calculate_merge_changes{
                 function => $force_functions{$field}{func},
                 key      => $force_functions{$field}{key},
                 options  => $force_functions{$field}{options},
-                allowed  => exists $force_functions{$field}{allowed} ? 0 : $force_functions{$field}{allowed},
+                allowed  => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
                };
            $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
-           if ($param->{force}) {
-               if ($field ne 'package') {
+           $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
+           if ($param->{force} or $change->{allowed}) {
+               if ($field ne 'package' or $change->{allowed}) {
                    push @{$changes{$data->{bug_num}}},$change;
                    next;
                }
@@ -3058,7 +3060,6 @@ sub bug_archive {
          print {$transcript} "Bug $param{bug} cannot be archived\n";
          die "Bug $param{bug} cannot be archived";
      }
-     print {$debug} "$param{bug} considering\n";
      if (not $param{archive_unarchived} and
         not exists $data[0]{unarchived}
        ) {
@@ -3572,7 +3573,8 @@ sub __begin_control {
                             );
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
-    print {$debug} "$param{bug} considering\n";
+    print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
+    print {$debug} Data::Dumper->Dump([caller(1),\%param],[qw(caller param)])."\n";
     $lockhash = $param{locks} if exists $param{locks};
     my @data = ();
     my $old_die = $SIG{__DIE__};