1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
# $NetBSD: SubstContext.pm,v 1.1 2015/11/25 16:42:21 rillig Exp $
#
# This class records the state of a block of variable assignments that make
# up a SUBST class. As these variable assignments are not easy to get right
# unless you do it every day, and the possibility of typos is high, pkglint
# provides additional checks for them.
#
package PkgLint::SubstContext;
use strict;
use warnings;
BEGIN {
import PkgLint::Util qw(
false true
);
import PkgLint::Logging qw(
log_warning
);
}
use enum qw(:SUBST_ ID CLASS STAGE MESSAGE FILES SED VARS FILTER_CMD);
sub new($) {
my ($class) = @_;
my ($self) = ([undef, undef, undef, undef, [], [], [], undef]);
bless($self, $class);
return $self;
}
sub subst_class($) { return shift()->[SUBST_CLASS]; }
sub subst_stage($) { return shift()->[SUBST_STAGE]; }
sub subst_message($) { return shift()->[SUBST_MESSAGE]; }
sub subst_files($) { return shift()->[SUBST_FILES]; }
sub subst_sed($) { return shift()->[SUBST_SED]; }
sub subst_vars($) { return shift()->[SUBST_VARS]; }
sub subst_filter_cmd($) { return shift()->[SUBST_FILTER_CMD]; }
sub subst_id($) { return shift()->[SUBST_ID]; }
sub init($) {
my ($self) = @_;
$self->[SUBST_ID] = undef;
$self->[SUBST_CLASS] = undef;
$self->[SUBST_STAGE] = undef;
$self->[SUBST_MESSAGE] = undef;
$self->[SUBST_FILES] = [];
$self->[SUBST_SED] = [];
$self->[SUBST_VARS] = [];
$self->[SUBST_FILTER_CMD] = undef;
}
sub check_end($$) {
my ($self, $line) = @_;
return unless defined($self->subst_id);
if (!defined($self->subst_class)) {
$main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_CLASSES missing.");
}
if (!defined($self->subst_stage)) {
$main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_STAGE missing.");
}
if (@{$self->subst_files} == 0) {
$main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_FILES missing.");
}
if (@{$self->subst_sed} == 0 && @{$self->subst_vars} == 0 && !defined($self->subst_filter_cmd)) {
$main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_SED or SUBST_VARS missing.");
}
$self->init();
}
sub is_complete($) {
my ($self) = @_;
return false unless defined($self->subst_id);
return false unless defined($self->subst_class);
return false unless defined($self->subst_files);
return false if @{$self->subst_sed} == 0 && @{$self->subst_vars} == 0;
return true;
}
sub check_varassign($$$$$) {
my ($self, $line, $varname, $op, $value) = @_;
my ($varbase, $varparam, $id);
if ($varname eq "SUBST_CLASSES") {
if ($value =~ m"^(\S+)\s") {
$main::opt_warn_extra and $line->log_warning("Please add only one class at a time to SUBST_CLASSES.");
$self->[SUBST_CLASS] = $1;
$self->[SUBST_ID] = $1;
} else {
if (defined($self->subst_class)) {
$main::opt_warn_extra and $line->log_warning("SUBST_CLASSES should only appear once in a SUBST block.");
}
$self->[SUBST_CLASS] = $value;
$self->[SUBST_ID] = $value;
}
return;
}
$id = $self->subst_id;
if ($varname =~ m"^(SUBST_(?:STAGE|MESSAGE|FILES|SED|VARS|FILTER_CMD))\.([\-\w_]+)$") {
($varbase, $varparam) = ($1, $2);
if (!defined($id)) {
$main::opt_warn_extra and $line->log_note("SUBST_CLASSES should precede the definition of ${varbase}.${varparam}.");
$id = $self->[SUBST_ID] = $varparam;
}
} else {
if (defined($id)) {
$main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
}
return;
}
if ($varparam ne $id) {
# XXX: This code sometimes produces weird warnings. See
# meta-pkgs/xorg/Makefile.common 1.41 for an example.
if ($self->is_complete()) {
$self->check_end($line);
# The following assignment prevents an additional warning,
# but from a technically viewpoint, it is incorrect.
$self->[SUBST_CLASS] = $varparam;
$self->[SUBST_ID] = $varparam;
$id = $varparam;
} else {
$main::opt_warn_extra and $line->log_warning("Variable parameter \"${varparam}\" does not match SUBST class \"${id}\".");
}
}
if ($varbase eq "SUBST_STAGE") {
if (defined($self->subst_stage)) {
$main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_STAGE.${id}.");
} else {
$self->[SUBST_STAGE] = $value;
}
} elsif ($varbase eq "SUBST_MESSAGE") {
if (defined($self->subst_message)) {
$main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_MESSAGE.${id}.");
} else {
$self->[SUBST_MESSAGE] = $value;
}
} elsif ($varbase eq "SUBST_FILES") {
if (@{$self->subst_files} > 0) {
if ($op ne "+=") {
$main::opt_warn_extra and $line->log_warning("All but the first SUBST_FILES line should use the \"+=\" operator.");
}
}
push(@{$self->subst_files}, $value);
} elsif ($varbase eq "SUBST_SED") {
if (@{$self->subst_sed} > 0) {
if ($op ne "+=") {
$main::opt_warn_extra and $line->log_warning("All but the first SUBST_SED line should use the \"+=\" operator.");
}
}
push(@{$self->subst_sed}, $value);
} elsif ($varbase eq "SUBST_FILTER_CMD") {
if (defined($self->subst_filter_cmd)) {
$main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_FILTER_CMD.${id}.");
} else {
$self->[SUBST_FILTER_CMD] = $value;
}
} elsif ($varbase eq "SUBST_VARS") {
if (@{$self->subst_vars} > 0) {
if ($op ne "+=") {
$main::opt_warn_extra and $line->log_warning("All but the first SUBST_VARS line should use the \"+=\" operator.");
}
}
push(@{$self->subst_vars}, $value);
} else {
$main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
}
}
sub to_string($) {
my ($self) = @_;
return sprintf("SubstContext(%s %s %s %s %s %s)",
(defined($self->subst_class) ? $self->subst_class : "(undef)"),
(defined($self->subst_stage) ? $self->subst_stage : "(undef)"),
(defined($self->subst_message) ? $self->subst_message : "(undef)"),
scalar(@{$self->subst_files}),
scalar(@{$self->subst_sed}),
(defined($self->subst_id) ? $self->subst_id : "(undef)"));
}
|
