Rewrite sequence handling to ensure add-on commands are ordered correctly

Previously, we relied on a command being inserted in the -arch
sequence to be ordered correctly.  With this rewrite, a command added
only to the -indep sequence will still appear in the right order.

Signed-off-by: Niels Thykier <niels@thykier.net>

2 files changed, 253 insertions, 17 deletions

diff --git a/lib/Debian/Debhelper/Sequence.pm b/lib/Debian/Debhelper/Sequence.pm
new file mode 100644
index 00000000..fc857055
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence.pm
@@ -0,0 +1,127 @@
+#!/usr/bin/perl
+#
+# Internal library functions for the dh(1) command
+
+package Debian::Debhelper::Sequence;
+use strict;
+use warnings;
+
+use Exporter qw(import);
+
+use Debian::Debhelper::SequencerUtil qw(extract_rules_target_name sequence_type	SEQUENCE_NO_SUBSEQUENCES
+	SEQUENCE_ARCH_INDEP_SUBSEQUENCES SEQUENCE_TYPE_ARCH_ONLY SEQUENCE_TYPE_INDEP_ONLY SEQUENCE_TYPE_BOTH);
+
+
+sub _as_command {
+	my ($input) = @_;
+	if (ref($input) eq 'HASH') {
+		return $input;
+	}
+	my $rules_target = extract_rules_target_name($input);
+	if (defined($rules_target)) {
+		my $sequence_type = sequence_type($rules_target);
+		return {
+			'command'             => $input,
+			'command-options'     => [],
+			'sequence-limitation' => $sequence_type,
+		}
+	}
+	return {
+		'command'             => $input,
+		'command-options'     => [],
+		'sequence-limitation' => SEQUENCE_TYPE_BOTH,
+	}
+}
+
+sub new {
+	my ($class, $name, $sequence_type, @cmds) = @_;
+	return bless({
+		'_name' => $name,
+		'_subsequences' => $sequence_type,
+		'_cmds' => [map {_as_command($_)} @cmds],
+	}, $class);
+}
+
+sub name {
+	my ($this) = @_;
+	return $this->{'_name'};
+}
+
+sub allowed_subsequences {
+	my ($this) = @_;
+	return $this->{'_subsequences'};
+}
+
+sub _insert {
+	my ($this, $offset, $existing, $new) = @_;
+	my @list = @{$this->{'_cmds'}};
+	my @new;
+	my $new_cmd = _as_command($new);
+	foreach my $command (@list) {
+		if ($command->{'command'} eq $existing) {
+			push(@new, $new_cmd) if $offset < 0;
+			push(@new, $command);
+			push(@new, $new_cmd) if $offset > 0;
+		} else {
+			push(@new, $command);
+		}
+	}
+	$this->{'_cmds'} = \@new;
+	return;
+}
+
+sub remove_command {
+	my ($this, $command) = @_;
+	$this->{'_cmds'} = [grep { $_->{'command'} ne $command } @{$this->{'_cmds'}}];
+	return;
+}
+
+sub add_command_at_start {
+	my ($this, $command) = @_;
+	unshift(@{$this->{'_cmds'}}, _as_command($command));
+	return;
+}
+
+sub add_command_at_end {
+	my ($this, $command) = @_;
+	push(@{$this->{'_cmds'}}, _as_command($command));
+	return;
+}
+
+sub rules_target_name {
+	my ($this, $sequence_type) = @_;
+	die("Internal error: Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
+	my $name = $this->{'_name'};
+	my $allowed_sequence_type = $this->{'_subsequences'};
+	if ($sequence_type ne SEQUENCE_TYPE_BOTH and $allowed_sequence_type eq SEQUENCE_NO_SUBSEQUENCES) {
+		die("Internal error: Requested subsequence ${sequence_type} of sequence ${name}, but it has no subsequences");
+	}
+	if ($sequence_type ne SEQUENCE_TYPE_BOTH) {
+		return "${name}-${sequence_type}";
+	}
+	return $name;
+}
+
+sub as_rules_target_command {
+	my ($this) = shift;
+	my $rules_name = $this->rules_target_name(@_);
+	return "debian/rules ${rules_name}";
+}
+
+sub flatten_sequence {
+	my ($this, $sequence_type) = @_;
+	die("Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
+	my @cmds;
+	for my $cmd_desc (@{$this->{'_cmds'}}) {
+		my $seq_limitation = $cmd_desc->{'sequence-limitation'};
+		if ($seq_limitation eq $sequence_type or $sequence_type eq SEQUENCE_TYPE_BOTH or $seq_limitation eq SEQUENCE_TYPE_BOTH) {
+			my $cmd = $cmd_desc->{'command'};
+			my @cmd_options = $cmd_desc->{'command-options'};
+			push(@cmds, [$cmd, @cmd_options]);
+			next;
+		}
+	}
+	return @cmds;
+}
+
+1;
diff --git a/lib/Debian/Debhelper/SequencerUtil.pm b/lib/Debian/Debhelper/SequencerUtil.pm
index 9a9ce2bf..a943357d 100644
--- a/lib/Debian/Debhelper/SequencerUtil.pm
+++ b/lib/Debian/Debhelper/SequencerUtil.pm
@@ -5,17 +5,30 @@
 package Debian::Debhelper::SequencerUtil;
 use strict;
 use warnings;
-use constant DUMMY_TARGET => 'debhelper-fail-me';
+use constant {
+	'DUMMY_TARGET' => 'debhelper-fail-me',
+	'SEQUENCE_NO_SUBSEQUENCES' => 'none',
+	'SEQUENCE_ARCH_INDEP_SUBSEQUENCES' => 'both',
+	'SEQUENCE_TYPE_ARCH_ONLY' => 'arch',
+	'SEQUENCE_TYPE_INDEP_ONLY' => 'indep',
+	'SEQUENCE_TYPE_BOTH' => 'both',
+};
 
 use Exporter qw(import);
 
 our @EXPORT = qw(
 	extract_rules_target_name
 	to_rules_target
+	sequence_type
 	unpack_sequence
 	rules_explicit_target
 	extract_skipinfo
 	DUMMY_TARGET
+	SEQUENCE_NO_SUBSEQUENCES
+	SEQUENCE_ARCH_INDEP_SUBSEQUENCES
+	SEQUENCE_TYPE_ARCH_ONLY
+	SEQUENCE_TYPE_INDEP_ONLY
+	SEQUENCE_TYPE_BOTH
 );
 
 our (%EXPLICIT_TARGETS, $RULES_PARSED);
@@ -32,39 +45,135 @@ sub to_rules_target  {
 	return 'debian/rules '.join(' ', @_);
 }
 
+sub sequence_type {
+	my ($sequence_name) = @_;
+	if ($sequence_name =~ m/-indep$/) {
+		return 'indep';
+	} elsif ($sequence_name =~ m/-arch/) {
+		return 'arch';
+	}
+	return 'both';
+}
+
+sub _agg_subseq {
+	my ($current_subseq, $outer_subseq) = @_;
+	if ($current_subseq eq $outer_subseq) {
+		return $current_subseq;
+	}
+	if ($current_subseq eq 'both') {
+		return $outer_subseq;
+	}
+	return $current_subseq;
+}
+
 sub unpack_sequence {
 	my ($sequences, $sequence_name, $always_inline, $completed_sequences) = @_;
 	my (@sequence, @targets, %seen, %non_inlineable_targets, @stack);
+	my $sequence_type = sequence_type($sequence_name);
 	# Walk through the sequence effectively doing a DFS of the rules targets
 	# (when we are allowed to inline them).
-	push(@stack, [@{$sequences->{$sequence_name}}]);
+	my $seq = $sequences->{$sequence_name};
+	push(@stack, [$seq->flatten_sequence($sequence_type)]);
 	while (@stack) {
 		my $current_sequence = pop(@stack);
 	  COMMAND:
 		while (@{$current_sequence}) {
 			my $command = shift(@{$current_sequence});
+			if (ref($command) eq 'ARRAY') {
+				$command = $command->[0];
+			}
 			my $rules_target=extract_rules_target_name($command);
 			next if (defined($rules_target) and exists($completed_sequences->{$rules_target}));
-			if (defined($rules_target) && ($always_inline ||
-				! exists($non_inlineable_targets{$rules_target}) &&
-				! defined(rules_explicit_target($rules_target)))) {
-
-				# inline the sequence for this implicit target.
+			if (defined($rules_target) and $always_inline) {
+				my $subsequence = $sequences->{$rules_target};
+				my $subseq_type = _agg_subseq(sequence_type($rules_target), $sequence_type);
 				push(@stack, $current_sequence);
-				$current_sequence = [@{$sequences->{$rules_target}}];
+				$current_sequence = [$subsequence->flatten_sequence($subseq_type)];
+			} elsif (defined($rules_target)) {
+				my $subsequence = $sequences->{$rules_target};
+				my $subseq_type = _agg_subseq(sequence_type($rules_target), $sequence_type);
+				my @subseq_types = ($subseq_type);
+				my %subtarget_status;
+				my ($transparent_subseq, $opaque_subseq, $subtarget_decided_both);
+				if ($subseq_type eq SEQUENCE_TYPE_BOTH) {
+					push(@subseq_types, SEQUENCE_TYPE_ARCH_ONLY, SEQUENCE_TYPE_INDEP_ONLY);
+				}
+				for my $ss_type (@subseq_types) {
+					my $full_rule_target = ($ss_type eq SEQUENCE_TYPE_BOTH) ? $rules_target : "${rules_target}-${ss_type}";
+					if (exists($completed_sequences->{$full_rule_target})) {
+						$subtarget_status{$ss_type} = 'complete';
+						last if $ss_type eq $subseq_type;
+					}
+					elsif (defined(rules_explicit_target($full_rule_target))) {
+						$subtarget_status{$ss_type} = 'opaque';
+						last if $ss_type eq $subseq_type;
+					}
+					else {
+						$subtarget_status{$ss_type} = 'transparent';
+					}
+				}
+				# At this point, %subtarget_status has 1 or 3 kv-pairs.
+				# - If it has 1, then just check that and be done
+				# - If it has 3, then "both" must be "transparent".
+
+				if (scalar(keys(%subtarget_status)) == 3) {
+					if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq $subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}}) {
+						# The "both" target is transparent and the subtargets agree.  This is the common case
+						# of "everything is transparent" (or both subtargets are opaque) and we reduce that by
+						# reducing it to only have one key.
+						%subtarget_status = ( $subseq_type => $subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} );
+						# There is one special-case for this flow if both targets are opaque.
+						$subtarget_decided_both = 1;
+					} else {
+						# The subtargets have different status but we know that the "both" key must be irrelevant
+						# then.  Remove it to simplify matters below.
+						delete($subtarget_status{${\SEQUENCE_TYPE_BOTH}});
+					}
+				}
+
+				if (scalar(keys(%subtarget_status)) == 1) {
+					# "Simple" case where we only have to check exactly one result
+					if ($subtarget_status{$subseq_type} eq 'opaque') {
+						$opaque_subseq = $subseq_type;
+					}
+					elsif ($subtarget_status{$subseq_type} eq 'transparent') {
+						$transparent_subseq = $subseq_type;
+					}
+				} else {
+					# Either can be transparent, opaque or complete at this point.
+					if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq 'transparent') {
+						$transparent_subseq = SEQUENCE_TYPE_ARCH_ONLY
+					} elsif ($subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}}  eq 'transparent') {
+						$transparent_subseq = SEQUENCE_TYPE_INDEP_ONLY
+					}
+					if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq 'opaque') {
+						$opaque_subseq = SEQUENCE_TYPE_ARCH_ONLY
+					} elsif ($subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}}  eq 'opaque') {
+						$opaque_subseq = SEQUENCE_TYPE_INDEP_ONLY
+					}
+				}
+				if ($opaque_subseq) {
+					if ($subtarget_decided_both) {
+						# Final special-case - we are here because the rules file define X-arch AND X-indep but
+						# not X.  In this case, we want two d/rules X-{arch,indep} calls rather than a single
+						# d/rules X call.
+						for my $ss_type ((SEQUENCE_TYPE_ARCH_ONLY, SEQUENCE_TYPE_INDEP_ONLY)) {
+							my $rules_target_cmd = $subsequence->as_rules_target_command($ss_type);
+							push(@targets, $rules_target_cmd) if not $seen{$rules_target_cmd}++;
+						}
+					} else {
+						my $rules_target_cmd = $subsequence->as_rules_target_command($opaque_subseq);
+						push(@targets, $rules_target_cmd) if not $seen{$rules_target_cmd}++;
+					}
+				}
+				if ($transparent_subseq) {
+					push(@stack, $current_sequence);
+					$current_sequence = [$subsequence->flatten_sequence($transparent_subseq)];
+				}
 				next COMMAND;
 			} else {
 				if (defined($rules_target) and not $always_inline) {
 					next COMMAND if exists($non_inlineable_targets{$rules_target});
-					my @opaque_targets = ($rules_target);
-					while (my $opaque_target = pop(@opaque_targets)) {
-						for my $c (@{$sequences->{$opaque_target}}) {
-							my $subtarget = extract_rules_target_name($c);
-							next if not defined($subtarget);
-							next if exists($non_inlineable_targets{$subtarget});
-							$non_inlineable_targets{$subtarget} = $rules_target;
-						}
-					}
 					push(@targets, $command) if not $seen{$command}++;
 				} elsif (! $seen{$command}) {
 					$seen{$command} = 1;