| 68 |
bj |
1 |
package WorkspaceCreator;
|
|
|
2 |
|
|
|
3 |
# ************************************************************
|
|
|
4 |
# Description : Base class for all workspace creators
|
|
|
5 |
# Author : Chad Elliott
|
|
|
6 |
# Create Date : 5/13/2002
|
|
|
7 |
# ************************************************************
|
|
|
8 |
|
|
|
9 |
# ************************************************************
|
|
|
10 |
# Pragmas
|
|
|
11 |
# ************************************************************
|
|
|
12 |
|
|
|
13 |
use strict;
|
|
|
14 |
use FileHandle;
|
|
|
15 |
use File::Path;
|
|
|
16 |
use File::Compare;
|
|
|
17 |
use File::Basename;
|
|
|
18 |
|
|
|
19 |
use Creator;
|
|
|
20 |
use Options;
|
|
|
21 |
|
|
|
22 |
use vars qw(@ISA);
|
|
|
23 |
@ISA = qw(Creator Options);
|
|
|
24 |
|
|
|
25 |
# ************************************************************
|
|
|
26 |
# Data Section
|
|
|
27 |
# ************************************************************
|
|
|
28 |
|
|
|
29 |
my($wsext) = 'mwc';
|
|
|
30 |
my($wsbase) = 'mwb';
|
|
|
31 |
|
|
|
32 |
## Valid names for assignments within a workspace
|
|
|
33 |
my(%validNames) = ('cmdline' => 1,
|
|
|
34 |
'implicit' => 1,
|
|
|
35 |
);
|
|
|
36 |
|
|
|
37 |
## Singleton hash maps of project information
|
|
|
38 |
my(%allprinfo) = ();
|
|
|
39 |
my(%allprojects) = ();
|
|
|
40 |
my(%allliblocs) = ();
|
|
|
41 |
|
|
|
42 |
## Global previous workspace names
|
|
|
43 |
my(%previous_workspace_name) = ();
|
|
|
44 |
|
|
|
45 |
## Constant aggregated workspace type name
|
|
|
46 |
my($aggregated) = 'aggregated_workspace';
|
|
|
47 |
|
|
|
48 |
# ************************************************************
|
|
|
49 |
# Subroutine Section
|
|
|
50 |
# ************************************************************
|
|
|
51 |
|
|
|
52 |
sub new {
|
|
|
53 |
my($class) = shift;
|
|
|
54 |
my($global) = shift;
|
|
|
55 |
my($inc) = shift;
|
|
|
56 |
my($template) = shift;
|
|
|
57 |
my($ti) = shift;
|
|
|
58 |
my($dynamic) = shift;
|
|
|
59 |
my($static) = shift;
|
|
|
60 |
my($relative) = shift;
|
|
|
61 |
my($addtemp) = shift;
|
|
|
62 |
my($addproj) = shift;
|
|
|
63 |
my($progress) = shift;
|
|
|
64 |
my($toplevel) = shift;
|
|
|
65 |
my($baseprojs) = shift;
|
|
|
66 |
my($gfeature) = shift;
|
|
|
67 |
my($feature) = shift;
|
|
|
68 |
my($features) = shift;
|
|
|
69 |
my($hierarchy) = shift;
|
|
|
70 |
my($exclude) = shift;
|
|
|
71 |
my($makeco) = shift;
|
|
|
72 |
my($nmod) = shift;
|
|
|
73 |
my($applypj) = shift;
|
|
|
74 |
my($genins) = shift;
|
|
|
75 |
my($into) = shift;
|
|
|
76 |
my($language) = shift;
|
|
|
77 |
my($use_env) = shift;
|
|
|
78 |
my($expandvars) = shift;
|
|
|
79 |
my($self) = Creator::new($class, $global, $inc,
|
|
|
80 |
$template, $ti, $dynamic, $static,
|
|
|
81 |
$relative, $addtemp, $addproj,
|
|
|
82 |
$progress, $toplevel, $baseprojs,
|
|
|
83 |
$feature, $features,
|
|
|
84 |
$hierarchy, $nmod, $applypj,
|
|
|
85 |
$into, $language, $use_env, $expandvars,
|
|
|
86 |
'workspace');
|
|
|
87 |
|
|
|
88 |
$self->{'workspace_name'} = undef;
|
|
|
89 |
$self->{$self->{'type_check'}} = 0;
|
|
|
90 |
$self->{'projects'} = [];
|
|
|
91 |
$self->{'project_info'} = {};
|
|
|
92 |
$self->{'lib_locations'} = {};
|
|
|
93 |
$self->{'reading_parent'} = [];
|
|
|
94 |
$self->{'project_files'} = [];
|
|
|
95 |
$self->{'scoped_assign'} = {};
|
|
|
96 |
$self->{'cacheok'} = 1;
|
|
|
97 |
$self->{'exclude'} = {};
|
|
|
98 |
$self->{'wctype'} = $self->extractType("$self");
|
|
|
99 |
$self->{'modified_count'} = 0;
|
|
|
100 |
$self->{'global_feature_file'} = $gfeature;
|
|
|
101 |
$self->{'coexistence'} = $makeco;
|
|
|
102 |
$self->{'project_file_list'} = {};
|
|
|
103 |
$self->{'ordering_cache'} = {};
|
|
|
104 |
$self->{'handled_scopes'} = {};
|
|
|
105 |
$self->{'generate_ins'} = $genins;
|
|
|
106 |
|
|
|
107 |
if (defined $$exclude[0]) {
|
|
|
108 |
my($type) = $self->{'wctype'};
|
|
|
109 |
if (!defined $self->{'exclude'}->{$type}) {
|
|
|
110 |
$self->{'exclude'}->{$type} = [];
|
|
|
111 |
}
|
|
|
112 |
push(@{$self->{'exclude'}->{$type}}, @$exclude);
|
|
|
113 |
}
|
|
|
114 |
|
|
|
115 |
## Add a hash reference for our workspace type
|
|
|
116 |
if (!defined $previous_workspace_name{$self->{'wctype'}}) {
|
|
|
117 |
$previous_workspace_name{$self->{'wctype'}} = {};
|
|
|
118 |
}
|
|
|
119 |
|
|
|
120 |
## Warn users about unnecessary options
|
|
|
121 |
if ($self->get_hierarchy() && $self->workspace_per_project()) {
|
|
|
122 |
$self->warning("The -hierarchy option is unnecessary " .
|
|
|
123 |
"for the " . $self->{'wctype'} . " type.");
|
|
|
124 |
}
|
|
|
125 |
if ($self->make_coexistence() && !$self->supports_make_coexistence()) {
|
|
|
126 |
$self->warning("Using the -make_coexistence option has " .
|
|
|
127 |
"no effect on the " . $self->{'wctype'} . " type.");
|
|
|
128 |
}
|
|
|
129 |
return $self;
|
|
|
130 |
}
|
|
|
131 |
|
|
|
132 |
|
|
|
133 |
sub modify_assignment_value {
|
|
|
134 |
my($self) = shift;
|
|
|
135 |
my($name) = shift;
|
|
|
136 |
my($value) = shift;
|
|
|
137 |
|
|
|
138 |
## Workspace assignments do not need modification.
|
|
|
139 |
return $value;
|
|
|
140 |
}
|
|
|
141 |
|
|
|
142 |
|
|
|
143 |
sub parse_line {
|
|
|
144 |
my($self) = shift;
|
|
|
145 |
my($ih) = shift;
|
|
|
146 |
my($line) = shift;
|
|
|
147 |
my($status, $error, @values) = $self->parse_known($line);
|
|
|
148 |
|
|
|
149 |
## Was the line recognized?
|
|
|
150 |
if ($status && defined $values[0]) {
|
|
|
151 |
if ($values[0] eq $self->{'grammar_type'}) {
|
|
|
152 |
my($name) = $values[1];
|
|
|
153 |
if (defined $name && $name eq '}') {
|
|
|
154 |
if (!defined $self->{'reading_parent'}->[0]) {
|
|
|
155 |
## Fill in all the default values
|
|
|
156 |
$self->generate_defaults();
|
|
|
157 |
|
|
|
158 |
## End of workspace; Have subclass write out the file
|
|
|
159 |
## Generate the project files
|
|
|
160 |
my($gstat, $creator) = $self->generate_project_files();
|
|
|
161 |
if ($gstat) {
|
|
|
162 |
($status, $error) = $self->write_workspace($creator, 1);
|
|
|
163 |
$self->{'assign'} = {};
|
|
|
164 |
}
|
|
|
165 |
else {
|
|
|
166 |
$error = 'Unable to generate all of the project files';
|
|
|
167 |
$status = 0;
|
|
|
168 |
}
|
|
|
169 |
|
|
|
170 |
$self->{'modified_count'} = 0;
|
|
|
171 |
$self->{'workspace_name'} = undef;
|
|
|
172 |
$self->{'projects'} = [];
|
|
|
173 |
$self->{'project_info'} = {};
|
|
|
174 |
$self->{'project_files'} = [];
|
|
|
175 |
}
|
|
|
176 |
$self->{$self->{'type_check'}} = 0;
|
|
|
177 |
}
|
|
|
178 |
else {
|
|
|
179 |
## Workspace Beginning
|
|
|
180 |
## Deal with the inheritance hiearchy first
|
|
|
181 |
if (defined $values[2]) {
|
|
|
182 |
foreach my $parent (@{$values[2]}) {
|
|
|
183 |
## Read in the parent onto ourself
|
|
|
184 |
my($file) = $self->search_include_path("$parent.$wsbase");
|
|
|
185 |
if (!defined $file) {
|
|
|
186 |
$file = $self->search_include_path("$parent.$wsext");
|
|
|
187 |
}
|
|
|
188 |
|
|
|
189 |
if (defined $file) {
|
|
|
190 |
push(@{$self->{'reading_parent'}}, 1);
|
|
|
191 |
$status = $self->parse_file($file);
|
|
|
192 |
pop(@{$self->{'reading_parent'}});
|
|
|
193 |
|
|
|
194 |
if (!$status) {
|
|
|
195 |
$error = "Invalid parent: $parent";
|
|
|
196 |
}
|
|
|
197 |
}
|
|
|
198 |
else {
|
|
|
199 |
$status = 0;
|
|
|
200 |
$error = "Unable to locate parent: $parent";
|
|
|
201 |
}
|
|
|
202 |
}
|
|
|
203 |
}
|
|
|
204 |
|
|
|
205 |
## Set up some initial values
|
|
|
206 |
if (defined $name) {
|
|
|
207 |
if ($name =~ /[\/\\]/) {
|
|
|
208 |
$status = 0;
|
|
|
209 |
$error = 'Workspaces can not have a slash ' .
|
|
|
210 |
'or a back slash in the name';
|
|
|
211 |
}
|
|
|
212 |
else {
|
|
|
213 |
$name =~ s/^\(\s*//;
|
|
|
214 |
$name =~ s/\s*\)$//;
|
|
|
215 |
|
|
|
216 |
## Replace any *'s with the default name
|
|
|
217 |
my($def) = $self->get_default_workspace_name();
|
|
|
218 |
$name = $self->fill_type_name($name, $def);
|
|
|
219 |
|
|
|
220 |
$self->{'workspace_name'} = $name;
|
|
|
221 |
}
|
|
|
222 |
}
|
|
|
223 |
$self->{$self->{'type_check'}} = 1;
|
|
|
224 |
}
|
|
|
225 |
}
|
|
|
226 |
elsif ($values[0] eq 'assignment') {
|
|
|
227 |
if (defined $validNames{$values[1]}) {
|
|
|
228 |
$self->process_assignment($values[1], $values[2]);
|
|
|
229 |
}
|
|
|
230 |
else {
|
|
|
231 |
$error = "Invalid assignment name: $values[1]";
|
|
|
232 |
$status = 0;
|
|
|
233 |
}
|
|
|
234 |
}
|
|
|
235 |
elsif ($values[0] eq 'assign_add') {
|
|
|
236 |
if (defined $validNames{$values[1]}) {
|
|
|
237 |
$self->process_assignment_add($values[1], $values[2]);
|
|
|
238 |
}
|
|
|
239 |
else {
|
|
|
240 |
$error = "Invalid addition name: $values[1]";
|
|
|
241 |
$status = 0;
|
|
|
242 |
}
|
|
|
243 |
}
|
|
|
244 |
elsif ($values[0] eq 'assign_sub') {
|
|
|
245 |
if (defined $validNames{$values[1]}) {
|
|
|
246 |
$self->process_assignment_sub($values[1], $values[2]);
|
|
|
247 |
}
|
|
|
248 |
else {
|
|
|
249 |
$error = "Invalid subtraction name: $values[1]";
|
|
|
250 |
$status = 0;
|
|
|
251 |
}
|
|
|
252 |
}
|
|
|
253 |
elsif ($values[0] eq 'component') {
|
|
|
254 |
if ($values[1] eq 'exclude') {
|
|
|
255 |
($status, $error) = $self->parse_exclude($ih, $values[2]);
|
|
|
256 |
}
|
|
|
257 |
else {
|
|
|
258 |
($status, $error) = $self->parse_scope($ih,
|
|
|
259 |
$values[1],
|
|
|
260 |
$values[2],
|
|
|
261 |
\%validNames);
|
|
|
262 |
}
|
|
|
263 |
}
|
|
|
264 |
else {
|
|
|
265 |
$error = "Unrecognized line: $line";
|
|
|
266 |
$status = 0;
|
|
|
267 |
}
|
|
|
268 |
}
|
|
|
269 |
elsif ($status == -1) {
|
|
|
270 |
if ($line =~ /\.$wsext$/) {
|
|
|
271 |
($status, $error) = $self->aggregated_workspace($line);
|
|
|
272 |
}
|
|
|
273 |
else {
|
|
|
274 |
push(@{$self->{'project_files'}}, $line);
|
|
|
275 |
$status = 1;
|
|
|
276 |
}
|
|
|
277 |
}
|
|
|
278 |
|
|
|
279 |
return $status, $error;
|
|
|
280 |
}
|
|
|
281 |
|
|
|
282 |
|
|
|
283 |
sub aggregated_workspace {
|
|
|
284 |
my($self) = shift;
|
|
|
285 |
my($file) = shift;
|
|
|
286 |
my($fh) = new FileHandle();
|
|
|
287 |
|
|
|
288 |
if (open($fh, $file)) {
|
|
|
289 |
my($oline) = $self->get_line_number();
|
|
|
290 |
my($tc) = $self->{$self->{'type_check'}};
|
|
|
291 |
my($ag) = $self->{'handled_scopes'}->{$aggregated};
|
|
|
292 |
my($psbd) = $self->{'scoped_basedir'};
|
|
|
293 |
my($status, $error, @values) = (0, 'No recognizable lines');
|
|
|
294 |
|
|
|
295 |
$self->{'handled_scopes'}->{$aggregated} = undef;
|
|
|
296 |
$self->set_line_number(0);
|
|
|
297 |
$self->{$self->{'type_check'}} = 0;
|
|
|
298 |
$self->{'scoped_basedir'} = $self->mpc_dirname($file);
|
|
|
299 |
|
|
|
300 |
while(<$fh>) {
|
|
|
301 |
my($line) = $self->preprocess_line($fh, $_);
|
|
|
302 |
($status, $error, @values) = $self->parse_known($line);
|
|
|
303 |
|
|
|
304 |
## Was the line recognized?
|
|
|
305 |
if ($status) {
|
|
|
306 |
if (defined $values[0]) {
|
|
|
307 |
if ($values[0] eq $self->{'grammar_type'}) {
|
|
|
308 |
if (defined $values[2]) {
|
|
|
309 |
my($name) = basename($file);
|
|
|
310 |
$name =~ s/\.[^\.]+$//;
|
|
|
311 |
$status = 0;
|
|
|
312 |
$error = 'Aggregated workspace (' . $name .
|
|
|
313 |
') can not inherit from another workspace';
|
|
|
314 |
}
|
|
|
315 |
else {
|
|
|
316 |
($status, $error) = $self->parse_scope($fh,
|
|
|
317 |
'',
|
|
|
318 |
$aggregated,
|
|
|
319 |
\%validNames);
|
|
|
320 |
}
|
|
|
321 |
}
|
|
|
322 |
else {
|
|
|
323 |
$status = 0;
|
|
|
324 |
$error = 'Unable to aggregate ' . $file;
|
|
|
325 |
}
|
|
|
326 |
last;
|
|
|
327 |
}
|
|
|
328 |
}
|
|
|
329 |
else {
|
|
|
330 |
last;
|
|
|
331 |
}
|
|
|
332 |
}
|
|
|
333 |
close($fh);
|
|
|
334 |
|
|
|
335 |
$self->{'scoped_basedir'} = $psbd;
|
|
|
336 |
$self->{'handled_scopes'}->{$aggregated} = $ag;
|
|
|
337 |
$self->{$self->{'type_check'}} = $tc;
|
|
|
338 |
$self->set_line_number($oline);
|
|
|
339 |
|
|
|
340 |
return $status, $error;
|
|
|
341 |
}
|
|
|
342 |
|
|
|
343 |
return 0, 'Unable to open ' . $file;
|
|
|
344 |
}
|
|
|
345 |
|
|
|
346 |
|
|
|
347 |
sub parse_exclude {
|
|
|
348 |
my($self) = shift;
|
|
|
349 |
my($fh) = shift;
|
|
|
350 |
my($typestr) = shift;
|
|
|
351 |
my($status) = 0;
|
|
|
352 |
my($errorString) = 'Unable to process exclude';
|
|
|
353 |
|
|
|
354 |
if ($typestr eq $self->get_default_component_name()) {
|
|
|
355 |
$typestr = $self->{'wctype'};
|
|
|
356 |
}
|
|
|
357 |
|
|
|
358 |
my(@exclude) = ();
|
|
|
359 |
my(%types) = ();
|
|
|
360 |
@types{split(/\s*,\s*/, $typestr)} = ();
|
|
|
361 |
|
|
|
362 |
|
|
|
363 |
## If there is a negation at all, add our
|
|
|
364 |
## current type, it may be removed below
|
|
|
365 |
if ($typestr =~ /!/) {
|
|
|
366 |
$types{$self->{wctype}} = 1;
|
|
|
367 |
|
|
|
368 |
## Process negated exclusions
|
|
|
369 |
foreach my $key (keys %types) {
|
|
|
370 |
if ($key =~ /^!(\w+)/) {
|
|
|
371 |
## Remove the negated key
|
|
|
372 |
delete $types{$key};
|
|
|
373 |
|
|
|
374 |
## Then delete the key that was negated in the exclusion.
|
|
|
375 |
delete $types{$1};
|
|
|
376 |
}
|
|
|
377 |
}
|
|
|
378 |
}
|
|
|
379 |
|
|
|
380 |
if (exists $types{$self->{wctype}}) {
|
|
|
381 |
while(<$fh>) {
|
|
|
382 |
my($line) = $self->preprocess_line($fh, $_);
|
|
|
383 |
|
|
|
384 |
if ($line eq '') {
|
|
|
385 |
}
|
|
|
386 |
elsif ($line =~ /^}(.*)$/) {
|
|
|
387 |
if (defined $1 && $1 ne '') {
|
|
|
388 |
$status = 0;
|
|
|
389 |
$errorString = "Trailing characters found: '$1'";
|
|
|
390 |
}
|
|
|
391 |
else {
|
|
|
392 |
$status = 1;
|
|
|
393 |
$errorString = undef;
|
|
|
394 |
}
|
|
|
395 |
last;
|
|
|
396 |
}
|
|
|
397 |
else {
|
|
|
398 |
push(@exclude, $line);
|
|
|
399 |
}
|
|
|
400 |
}
|
|
|
401 |
|
|
|
402 |
foreach my $type (keys %types) {
|
|
|
403 |
if (!defined $self->{'exclude'}->{$type}) {
|
|
|
404 |
$self->{'exclude'}->{$type} = [];
|
|
|
405 |
}
|
|
|
406 |
push(@{$self->{'exclude'}->{$type}}, @exclude);
|
|
|
407 |
}
|
|
|
408 |
}
|
|
|
409 |
else {
|
|
|
410 |
($status, $errorString) = $self->parse_scope($fh,
|
|
|
411 |
'exclude',
|
|
|
412 |
$typestr,
|
|
|
413 |
\%validNames);
|
|
|
414 |
}
|
|
|
415 |
|
|
|
416 |
return $status, $errorString;
|
|
|
417 |
}
|
|
|
418 |
|
|
|
419 |
|
|
|
420 |
sub excluded {
|
|
|
421 |
my($self) = shift;
|
|
|
422 |
my($file) = shift;
|
|
|
423 |
|
|
|
424 |
foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
|
|
|
425 |
if ($excluded eq $file || $file =~ /^$excluded\//) {
|
|
|
426 |
return 1;
|
|
|
427 |
}
|
|
|
428 |
}
|
|
|
429 |
|
|
|
430 |
return 0;
|
|
|
431 |
}
|
|
|
432 |
|
|
|
433 |
|
|
|
434 |
sub handle_scoped_end {
|
|
|
435 |
my($self) = shift;
|
|
|
436 |
my($type) = shift;
|
|
|
437 |
my($flags) = shift;
|
|
|
438 |
my($status) = 1;
|
|
|
439 |
my($error) = undef;
|
|
|
440 |
|
|
|
441 |
if ($type eq $aggregated &&
|
|
|
442 |
!defined $self->{'handled_scopes'}->{$type}) {
|
|
|
443 |
## Replace instances of $PWD with the current directory plus the
|
|
|
444 |
## scoped_basedir. We have to do it now otherwise, $PWD will be the
|
|
|
445 |
## wrong directory if it's done later.
|
|
|
446 |
if (defined $$flags{'cmdline'}) {
|
|
|
447 |
my($dir) = $self->getcwd() . '/' . $self->{'scoped_basedir'};
|
|
|
448 |
$$flags{'cmdline'} =~ s/\$PWD(\W)/$dir$1/g;
|
|
|
449 |
$$flags{'cmdline'} =~ s/\$PWD$/$dir/;
|
|
|
450 |
}
|
|
|
451 |
|
|
|
452 |
## Go back to the previous directory and add the directory contents
|
|
|
453 |
($status, $error) = $self->handle_scoped_unknown($type, $flags, '.');
|
|
|
454 |
}
|
|
|
455 |
|
|
|
456 |
$self->{'handled_scopes'}->{$type} = undef;
|
|
|
457 |
return $status, $error;
|
|
|
458 |
}
|
|
|
459 |
|
|
|
460 |
|
|
|
461 |
sub handle_scoped_unknown {
|
|
|
462 |
my($self) = shift;
|
|
|
463 |
my($type) = shift;
|
|
|
464 |
my($flags) = shift;
|
|
|
465 |
my($line) = shift;
|
|
|
466 |
my($status) = 1;
|
|
|
467 |
my($error) = undef;
|
|
|
468 |
my($dupchk) = undef;
|
|
|
469 |
|
|
|
470 |
if ($type eq $aggregated) {
|
|
|
471 |
$line = $self->{'scoped_basedir'} . ($line ne '.' ? "/$line" : '');
|
|
|
472 |
my(%dup) = ();
|
|
|
473 |
@dup{@{$self->{'project_files'}}} = ();
|
|
|
474 |
$dupchk = \%dup;
|
|
|
475 |
}
|
|
|
476 |
|
|
|
477 |
if (-d $line) {
|
|
|
478 |
my(@files) = ();
|
|
|
479 |
$self->search_for_files([ $line ], \@files, $$flags{'implicit'});
|
|
|
480 |
|
|
|
481 |
## If we are generating implicit projects within a scope, then
|
|
|
482 |
## we need to remove directories and the parent directories for which
|
|
|
483 |
## there is an mpc file. Otherwise, the projects will be added
|
|
|
484 |
## twice.
|
|
|
485 |
if ($$flags{'implicit'}) {
|
|
|
486 |
my(%remove) = ();
|
|
|
487 |
foreach my $file (@files) {
|
|
|
488 |
if ($file =~ /\.mpc$/) {
|
|
|
489 |
my($exc) = $file;
|
|
|
490 |
do {
|
|
|
491 |
$exc = $self->mpc_dirname($exc);
|
|
|
492 |
$remove{$exc} = 1;
|
|
|
493 |
} while($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i);
|
|
|
494 |
}
|
|
|
495 |
}
|
|
|
496 |
|
|
|
497 |
my(@acceptable) = ();
|
|
|
498 |
foreach my $file (@files) {
|
|
|
499 |
if (!defined $remove{$file}) {
|
|
|
500 |
push(@acceptable, $file);
|
|
|
501 |
}
|
|
|
502 |
}
|
|
|
503 |
@files = @acceptable;
|
|
|
504 |
}
|
|
|
505 |
|
|
|
506 |
if (defined $dupchk) {
|
|
|
507 |
foreach my $file (@files) {
|
|
|
508 |
if (exists $$dupchk{$file}) {
|
|
|
509 |
$self->warning("Duplicate mpc file ($file) added by an " .
|
|
|
510 |
'aggregate workspace. It will be ignored.');
|
|
|
511 |
}
|
|
|
512 |
else {
|
|
|
513 |
$self->{'scoped_assign'}->{$file} = $flags;
|
|
|
514 |
push(@{$self->{'project_files'}}, $file);
|
|
|
515 |
}
|
|
|
516 |
}
|
|
|
517 |
}
|
|
|
518 |
else {
|
|
|
519 |
foreach my $file (@files) {
|
|
|
520 |
$self->{'scoped_assign'}->{$file} = $flags;
|
|
|
521 |
push(@{$self->{'project_files'}}, $file);
|
|
|
522 |
}
|
|
|
523 |
}
|
|
|
524 |
}
|
|
|
525 |
else {
|
|
|
526 |
if ($line =~ /\.$wsext$/) {
|
|
|
527 |
## An aggregated workspace within an aggregated workspace.
|
|
|
528 |
($status, $error) = $self->aggregated_workspace($line);
|
|
|
529 |
}
|
|
|
530 |
else {
|
|
|
531 |
if (defined $dupchk && exists $$dupchk{$line}) {
|
|
|
532 |
$self->warning("Duplicate mpc file ($line) added by an " .
|
|
|
533 |
'aggregate workspace. It will be ignored.');
|
|
|
534 |
}
|
|
|
535 |
else {
|
|
|
536 |
$self->{'scoped_assign'}->{$line} = $flags;
|
|
|
537 |
push(@{$self->{'project_files'}}, $line);
|
|
|
538 |
}
|
|
|
539 |
}
|
|
|
540 |
}
|
|
|
541 |
$self->{'handled_scopes'}->{$type} = 1;
|
|
|
542 |
|
|
|
543 |
return $status, $error;
|
|
|
544 |
}
|
|
|
545 |
|
|
|
546 |
|
|
|
547 |
sub search_for_files {
|
|
|
548 |
my($self) = shift;
|
|
|
549 |
my($files) = shift;
|
|
|
550 |
my($array) = shift;
|
|
|
551 |
my($impl) = shift;
|
|
|
552 |
|
|
|
553 |
foreach my $file (@$files) {
|
|
|
554 |
if (-d $file) {
|
|
|
555 |
my(@f) = $self->generate_default_file_list(
|
|
|
556 |
$file,
|
|
|
557 |
$self->{'exclude'}->{$self->{'wctype'}});
|
|
|
558 |
$self->search_for_files(\@f, $array, $impl);
|
|
|
559 |
if ($impl) {
|
|
|
560 |
unshift(@$array, $file);
|
|
|
561 |
}
|
|
|
562 |
}
|
|
|
563 |
else {
|
|
|
564 |
if ($file =~ /\.mpc$/) {
|
|
|
565 |
unshift(@$array, $file);
|
|
|
566 |
}
|
|
|
567 |
}
|
|
|
568 |
}
|
|
|
569 |
}
|
|
|
570 |
|
|
|
571 |
|
|
|
572 |
sub remove_duplicate_projects {
|
|
|
573 |
my($self) = shift;
|
|
|
574 |
my($list) = shift;
|
|
|
575 |
my($count) = scalar(@$list);
|
|
|
576 |
|
|
|
577 |
for(my $i = 0; $i < $count; ++$i) {
|
|
|
578 |
my($file) = $$list[$i];
|
|
|
579 |
foreach my $inner (@$list) {
|
|
|
580 |
if ($file ne $inner && $file eq $self->mpc_dirname($inner) && ! -d $inner) {
|
|
|
581 |
splice(@$list, $i, 1);
|
|
|
582 |
--$count;
|
|
|
583 |
--$i;
|
|
|
584 |
last;
|
|
|
585 |
}
|
|
|
586 |
}
|
|
|
587 |
}
|
|
|
588 |
}
|
|
|
589 |
|
|
|
590 |
|
|
|
591 |
sub generate_default_components {
|
|
|
592 |
my($self) = shift;
|
|
|
593 |
my($files) = shift;
|
|
|
594 |
my($impl) = shift;
|
|
|
595 |
my($pjf) = $self->{'project_files'};
|
|
|
596 |
|
|
|
597 |
if (defined $$pjf[0]) {
|
|
|
598 |
## If we have files, then process directories
|
|
|
599 |
my(@built) = ();
|
|
|
600 |
foreach my $file (@$pjf) {
|
|
|
601 |
if (!$self->excluded($file)) {
|
|
|
602 |
if (-d $file) {
|
|
|
603 |
my(@found) = ();
|
|
|
604 |
my(@gen) = $self->generate_default_file_list(
|
|
|
605 |
$file,
|
|
|
606 |
$self->{'exclude'}->{$self->{'wctype'}});
|
|
|
607 |
$self->search_for_files(\@gen, \@found, $impl);
|
|
|
608 |
push(@built, @found);
|
|
|
609 |
if ($impl || $self->{'scoped_assign'}->{$file}->{'implicit'}) {
|
|
|
610 |
push(@built, $file);
|
|
|
611 |
}
|
|
|
612 |
}
|
|
|
613 |
else {
|
|
|
614 |
push(@built, $file);
|
|
|
615 |
}
|
|
|
616 |
}
|
|
|
617 |
}
|
|
|
618 |
|
|
|
619 |
## If the workspace is set to implicit
|
|
|
620 |
if ($impl) {
|
|
|
621 |
## Remove duplicates from this list
|
|
|
622 |
$self->remove_duplicate_projects(\@built);
|
|
|
623 |
}
|
|
|
624 |
|
|
|
625 |
## Set the project files
|
|
|
626 |
$self->{'project_files'} = \@built;
|
|
|
627 |
}
|
|
|
628 |
else {
|
|
|
629 |
## Add all of the wanted files in this directory
|
|
|
630 |
## and in the subdirectories.
|
|
|
631 |
$self->search_for_files($files, $pjf, $impl);
|
|
|
632 |
|
|
|
633 |
## If the workspace is set to implicit
|
|
|
634 |
if ($impl) {
|
|
|
635 |
## Remove duplicates from this list
|
|
|
636 |
$self->remove_duplicate_projects($pjf);
|
|
|
637 |
}
|
|
|
638 |
|
|
|
639 |
## If no files were found, then we push the empty
|
|
|
640 |
## string, so the Project Creator will generate
|
|
|
641 |
## the default project file.
|
|
|
642 |
if (!defined $$pjf[0]) {
|
|
|
643 |
push(@$pjf, '');
|
|
|
644 |
}
|
|
|
645 |
}
|
|
|
646 |
}
|
|
|
647 |
|
|
|
648 |
|
|
|
649 |
sub get_default_workspace_name {
|
|
|
650 |
my($self) = shift;
|
|
|
651 |
my($name) = $self->{'current_input'};
|
|
|
652 |
|
|
|
653 |
if ($name eq '') {
|
|
|
654 |
$name = $self->base_directory();
|
|
|
655 |
}
|
|
|
656 |
else {
|
|
|
657 |
## Since files on UNIX can have back slashes, we transform them
|
|
|
658 |
## into underscores.
|
|
|
659 |
$name =~ s/\\/_/g;
|
|
|
660 |
|
|
|
661 |
## Take off the extension
|
|
|
662 |
$name =~ s/\.[^\.]+$//;
|
|
|
663 |
}
|
|
|
664 |
|
|
|
665 |
return $name;
|
|
|
666 |
}
|
|
|
667 |
|
|
|
668 |
|
|
|
669 |
sub generate_defaults {
|
|
|
670 |
my($self) = shift;
|
|
|
671 |
|
|
|
672 |
## Generate default workspace name
|
|
|
673 |
if (!defined $self->{'workspace_name'}) {
|
|
|
674 |
$self->{'workspace_name'} = $self->get_default_workspace_name();
|
|
|
675 |
}
|
|
|
676 |
|
|
|
677 |
my(@files) = $self->generate_default_file_list(
|
|
|
678 |
'.',
|
|
|
679 |
$self->{'exclude'}->{$self->{'wctype'}});
|
|
|
680 |
|
|
|
681 |
## Generate default components
|
|
|
682 |
$self->generate_default_components(\@files,
|
|
|
683 |
$self->get_assignment('implicit'));
|
|
|
684 |
}
|
|
|
685 |
|
|
|
686 |
|
|
|
687 |
sub get_workspace_name {
|
|
|
688 |
my($self) = shift;
|
|
|
689 |
return $self->{'workspace_name'};
|
|
|
690 |
}
|
|
|
691 |
|
|
|
692 |
|
|
|
693 |
sub get_current_output_name {
|
|
|
694 |
my($self) = shift;
|
|
|
695 |
return $self->{'current_output'};
|
|
|
696 |
}
|
|
|
697 |
|
|
|
698 |
|
|
|
699 |
sub write_workspace {
|
|
|
700 |
my($self) = shift;
|
|
|
701 |
my($creator) = shift;
|
|
|
702 |
my($addfile) = shift;
|
|
|
703 |
my($status) = 1;
|
|
|
704 |
my($error) = undef;
|
|
|
705 |
my($duplicates) = 0;
|
|
|
706 |
|
|
|
707 |
if ($self->get_toplevel()) {
|
|
|
708 |
my($progress) = $self->get_progress_callback();
|
|
|
709 |
|
|
|
710 |
if (defined $progress) {
|
|
|
711 |
&$progress();
|
|
|
712 |
}
|
|
|
713 |
|
|
|
714 |
if ($addfile) {
|
|
|
715 |
## To be consistent across multiple project types, we disallow
|
|
|
716 |
## duplicate project names for all types, not just VC6.
|
|
|
717 |
## Note that these name are handled case-insensitive by VC6
|
|
|
718 |
my(%names) = ();
|
|
|
719 |
foreach my $project (@{$self->{'projects'}}) {
|
|
|
720 |
my($name) = lc($self->{'project_info'}->{$project}->[0]);
|
|
|
721 |
if (defined $names{$name}) {
|
|
|
722 |
++$duplicates;
|
|
|
723 |
$self->error("Duplicate case-insensitive project '$name'. " .
|
|
|
724 |
"Look in " . $self->mpc_dirname($project) . " and " .
|
|
|
725 |
$self->mpc_dirname($names{$name}) .
|
|
|
726 |
" for project name conflicts.");
|
|
|
727 |
}
|
|
|
728 |
else {
|
|
|
729 |
$names{$name} = $project;
|
|
|
730 |
}
|
|
|
731 |
}
|
|
|
732 |
}
|
|
|
733 |
else {
|
|
|
734 |
$self->{'per_project_workspace_name'} = 1;
|
|
|
735 |
}
|
|
|
736 |
|
|
|
737 |
my($name) = $self->transform_file_name($self->workspace_file_name());
|
|
|
738 |
my($outdir) = $self->get_outdir();
|
|
|
739 |
my($oname) = $name;
|
|
|
740 |
|
|
|
741 |
$name = "$outdir/$name";
|
|
|
742 |
|
|
|
743 |
my($abort_creation) = 0;
|
|
|
744 |
if ($duplicates > 0) {
|
|
|
745 |
$abort_creation = 1;
|
|
|
746 |
$error = "Duplicate case-insensitive project names are " .
|
|
|
747 |
"not allowed within a workspace.";
|
|
|
748 |
$status = 0;
|
|
|
749 |
}
|
|
|
750 |
else {
|
|
|
751 |
if (!defined $self->{'projects'}->[0]) {
|
|
|
752 |
$self->information('No projects were created.');
|
|
|
753 |
$abort_creation = 1;
|
|
|
754 |
}
|
|
|
755 |
}
|
|
|
756 |
|
|
|
757 |
if (!$abort_creation) {
|
|
|
758 |
my($fh) = new FileHandle();
|
|
|
759 |
my($dir) = $self->mpc_dirname($name);
|
|
|
760 |
|
|
|
761 |
## Verify and possibly modify the dependencies
|
|
|
762 |
if ($addfile) {
|
|
|
763 |
$self->verify_build_ordering();
|
|
|
764 |
}
|
|
|
765 |
|
|
|
766 |
if ($dir ne '.') {
|
|
|
767 |
mkpath($dir, 0, 0777);
|
|
|
768 |
}
|
|
|
769 |
|
|
|
770 |
if ($addfile || !$self->file_written($name)) {
|
|
|
771 |
$self->{'current_output'} = $name;
|
|
|
772 |
if ($self->compare_output()) {
|
|
|
773 |
## First write the output to a temporary file
|
|
|
774 |
my($tmp) = "$outdir/MWC$>.$$";
|
|
|
775 |
my($different) = 1;
|
|
|
776 |
if (open($fh, ">$tmp")) {
|
|
|
777 |
$self->pre_workspace($fh);
|
|
|
778 |
$self->write_comps($fh, $creator, $addfile);
|
|
|
779 |
$self->post_workspace($fh);
|
|
|
780 |
close($fh);
|
|
|
781 |
|
|
|
782 |
if (-r $name &&
|
|
|
783 |
-s $tmp == -s $name && compare($tmp, $name) == 0) {
|
|
|
784 |
$different = 0;
|
|
|
785 |
}
|
|
|
786 |
}
|
|
|
787 |
else {
|
|
|
788 |
$error = "Unable to open $tmp for output.";
|
|
|
789 |
$status = 0;
|
|
|
790 |
}
|
|
|
791 |
|
|
|
792 |
if ($status) {
|
|
|
793 |
if ($different) {
|
|
|
794 |
unlink($name);
|
|
|
795 |
if (rename($tmp, $name)) {
|
|
|
796 |
if ($addfile) {
|
|
|
797 |
$self->add_file_written($oname);
|
|
|
798 |
}
|
|
|
799 |
}
|
|
|
800 |
else {
|
|
|
801 |
$error = 'Unable to open ' . $self->getcwd() .
|
|
|
802 |
"/$name for output";
|
|
|
803 |
$status = 0;
|
|
|
804 |
}
|
|
|
805 |
}
|
|
|
806 |
else {
|
|
|
807 |
## We will pretend that we wrote the file
|
|
|
808 |
unlink($tmp);
|
|
|
809 |
if ($addfile) {
|
|
|
810 |
$self->add_file_written($oname);
|
|
|
811 |
}
|
|
|
812 |
}
|
|
|
813 |
}
|
|
|
814 |
}
|
|
|
815 |
else {
|
|
|
816 |
if (open($fh, ">$name")) {
|
|
|
817 |
$self->pre_workspace($fh);
|
|
|
818 |
$self->write_comps($fh, $creator, $addfile);
|
|
|
819 |
$self->post_workspace($fh);
|
|
|
820 |
close($fh);
|
|
|
821 |
|
|
|
822 |
if ($addfile) {
|
|
|
823 |
$self->add_file_written($oname);
|
|
|
824 |
}
|
|
|
825 |
}
|
|
|
826 |
else {
|
|
|
827 |
$error = "Unable to open $name for output.";
|
|
|
828 |
$status = 0;
|
|
|
829 |
}
|
|
|
830 |
}
|
|
|
831 |
}
|
|
|
832 |
}
|
|
|
833 |
|
|
|
834 |
if (!$addfile) {
|
|
|
835 |
$self->{'per_project_workspace_name'} = undef;
|
|
|
836 |
}
|
|
|
837 |
}
|
|
|
838 |
|
|
|
839 |
return $status, $error;
|
|
|
840 |
}
|
|
|
841 |
|
|
|
842 |
|
|
|
843 |
sub save_project_info {
|
|
|
844 |
my($self) = shift;
|
|
|
845 |
my($gen) = shift;
|
|
|
846 |
my($gpi) = shift;
|
|
|
847 |
my($gll) = shift;
|
|
|
848 |
my($dir) = shift;
|
|
|
849 |
my($projects) = shift;
|
|
|
850 |
my($pi) = shift;
|
|
|
851 |
my($ll) = shift;
|
|
|
852 |
my($c) = 0;
|
|
|
853 |
|
|
|
854 |
## For each file written
|
|
|
855 |
foreach my $pj (@$gen) {
|
|
|
856 |
## Save the full path to the project file in the array
|
|
|
857 |
my($full) = ($dir ne '.' ? "$dir/" : '') . $pj;
|
|
|
858 |
push(@$projects, $full);
|
|
|
859 |
|
|
|
860 |
## Get the corresponding generated project info and save it
|
|
|
861 |
## in the hash map keyed on the full project file name
|
|
|
862 |
$$pi{$full} = $$gpi[$c];
|
|
|
863 |
$c++;
|
|
|
864 |
}
|
|
|
865 |
|
|
|
866 |
foreach my $key (keys %$gll) {
|
|
|
867 |
$$ll{$key} = $$gll{$key};
|
|
|
868 |
}
|
|
|
869 |
}
|
|
|
870 |
|
|
|
871 |
|
|
|
872 |
sub topname {
|
|
|
873 |
my($self) = shift;
|
|
|
874 |
my($file) = shift;
|
|
|
875 |
my($dir) = '.';
|
|
|
876 |
my($rest) = $file;
|
|
|
877 |
if ($file =~ /^([^\/\\]+)[\/\\](.*)/) {
|
|
|
878 |
$dir = $1;
|
|
|
879 |
$rest = $2;
|
|
|
880 |
}
|
|
|
881 |
return $dir, $rest;
|
|
|
882 |
}
|
|
|
883 |
|
|
|
884 |
|
|
|
885 |
sub generate_hierarchy {
|
|
|
886 |
my($self) = shift;
|
|
|
887 |
my($creator) = shift;
|
|
|
888 |
my($origproj) = shift;
|
|
|
889 |
my($originfo) = shift;
|
|
|
890 |
my($current) = undef;
|
|
|
891 |
my(@saved) = ();
|
|
|
892 |
my(%sinfo) = ();
|
|
|
893 |
my($cwd) = $self->getcwd();
|
|
|
894 |
|
|
|
895 |
## Make a copy of these. We will be modifying them.
|
|
|
896 |
## It is necessary to sort the projects to get the correct ordering.
|
|
|
897 |
## Projects in the current directory must come before projects in
|
|
|
898 |
## other directories.
|
|
|
899 |
my(@projects) = sort { my($sa) = ($a =~ /\//);
|
|
|
900 |
my($sb) = ($b =~ /\//);
|
|
|
901 |
if ($sa && !$sb) {
|
|
|
902 |
return 1;
|
|
|
903 |
}
|
|
|
904 |
elsif ($sb && !$sa) {
|
|
|
905 |
return -1;
|
|
|
906 |
}
|
|
|
907 |
return $a cmp $b;
|
|
|
908 |
} @{$origproj};
|
|
|
909 |
my(%projinfo) = %{$originfo};
|
|
|
910 |
|
|
|
911 |
foreach my $prj (@projects) {
|
|
|
912 |
my($top, $rest) = $self->topname($prj);
|
|
|
913 |
|
|
|
914 |
if (!defined $current) {
|
|
|
915 |
$current = $top;
|
|
|
916 |
push(@saved, $rest);
|
|
|
917 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
918 |
}
|
|
|
919 |
elsif ($top ne $current) {
|
|
|
920 |
if ($current ne '.') {
|
|
|
921 |
## Write out the hierachical workspace
|
|
|
922 |
$self->cd($current);
|
|
|
923 |
$self->generate_hierarchy($creator, \@saved, \%sinfo);
|
|
|
924 |
|
|
|
925 |
$self->{'projects'} = \@saved;
|
|
|
926 |
$self->{'project_info'} = \%sinfo;
|
|
|
927 |
$self->{'workspace_name'} = $self->base_directory();
|
|
|
928 |
|
|
|
929 |
my($status, $error) = $self->write_workspace($creator);
|
|
|
930 |
if (!$status) {
|
|
|
931 |
$self->error($error);
|
|
|
932 |
}
|
|
|
933 |
$self->cd($cwd);
|
|
|
934 |
}
|
|
|
935 |
|
|
|
936 |
## Start the next one
|
|
|
937 |
$current = $top;
|
|
|
938 |
@saved = ($rest);
|
|
|
939 |
%sinfo = ();
|
|
|
940 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
941 |
}
|
|
|
942 |
else {
|
|
|
943 |
push(@saved, $rest);
|
|
|
944 |
$sinfo{$rest} = $projinfo{$prj};
|
|
|
945 |
}
|
|
|
946 |
}
|
|
|
947 |
if (defined $current && $current ne '.') {
|
|
|
948 |
$self->cd($current);
|
|
|
949 |
$self->generate_hierarchy($creator, \@saved, \%sinfo);
|
|
|
950 |
|
|
|
951 |
$self->{'projects'} = \@saved;
|
|
|
952 |
$self->{'project_info'} = \%sinfo;
|
|
|
953 |
$self->{'workspace_name'} = $self->base_directory();
|
|
|
954 |
|
|
|
955 |
my($status, $error) = $self->write_workspace($creator);
|
|
|
956 |
if (!$status) {
|
|
|
957 |
$self->error($error);
|
|
|
958 |
}
|
|
|
959 |
$self->cd($cwd);
|
|
|
960 |
}
|
|
|
961 |
}
|
|
|
962 |
|
|
|
963 |
|
|
|
964 |
sub generate_project_files {
|
|
|
965 |
my($self) = shift;
|
|
|
966 |
my($status) = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0);
|
|
|
967 |
my(@projects) = ();
|
|
|
968 |
my(%pi) = ();
|
|
|
969 |
my(%liblocs) = ();
|
|
|
970 |
my($creator) = $self->project_creator();
|
|
|
971 |
my($cwd) = $self->getcwd();
|
|
|
972 |
my($impl) = $self->get_assignment('implicit');
|
|
|
973 |
my($postkey) = $creator->get_dynamic() .
|
|
|
974 |
$creator->get_static() . "-$self";
|
|
|
975 |
my($previmpl) = $impl;
|
|
|
976 |
my($prevcache) = $self->{'cacheok'};
|
|
|
977 |
my(%gstate) = $creator->save_state();
|
|
|
978 |
my($genimpdep) = $self->generate_implicit_project_dependencies();
|
|
|
979 |
|
|
|
980 |
## Remove the address portion of the $self string
|
|
|
981 |
$postkey =~ s/=.*//;
|
|
|
982 |
|
|
|
983 |
## Set the source file callback on our project creator
|
|
|
984 |
$creator->set_source_listing_callback([\&source_listing_callback, $self]);
|
|
|
985 |
|
|
|
986 |
foreach my $ofile (@{$self->{'project_files'}}) {
|
|
|
987 |
if (!$self->excluded($ofile)) {
|
|
|
988 |
my($file) = $ofile;
|
|
|
989 |
my($dir) = $self->mpc_dirname($file);
|
|
|
990 |
my($restore) = 0;
|
|
|
991 |
|
|
|
992 |
if (defined $self->{'scoped_assign'}->{$ofile}) {
|
|
|
993 |
## Handle the implicit assignment
|
|
|
994 |
my($oi) = $self->{'scoped_assign'}->{$ofile}->{'implicit'};
|
|
|
995 |
if (defined $oi) {
|
|
|
996 |
$previmpl = $impl;
|
|
|
997 |
$impl = $oi;
|
|
|
998 |
}
|
|
|
999 |
|
|
|
1000 |
## Handle the cmdline assignment
|
|
|
1001 |
my($cmdline) = $self->{'scoped_assign'}->{$ofile}->{'cmdline'};
|
|
|
1002 |
if (defined $cmdline && $cmdline ne '') {
|
|
|
1003 |
## Save the cacheok value
|
|
|
1004 |
$prevcache = $self->{'cacheok'};
|
|
|
1005 |
|
|
|
1006 |
## Get the current parameters and process the command line
|
|
|
1007 |
my(%parameters) = $self->current_parameters();
|
|
|
1008 |
$self->process_cmdline($cmdline, \%parameters);
|
|
|
1009 |
|
|
|
1010 |
## Set the parameters on the creator
|
|
|
1011 |
$creator->restore_state(\%parameters);
|
|
|
1012 |
$restore = 1;
|
|
|
1013 |
}
|
|
|
1014 |
}
|
|
|
1015 |
|
|
|
1016 |
## If we are generating implicit projects and the file is a
|
|
|
1017 |
## directory, then we set the dir to the file and empty the file
|
|
|
1018 |
if ($impl && -d $file) {
|
|
|
1019 |
$dir = $file;
|
|
|
1020 |
$file = '';
|
|
|
1021 |
|
|
|
1022 |
## If the implicit assignment value was not a number, then
|
|
|
1023 |
## we will add this value to our base projects.
|
|
|
1024 |
if ($impl !~ /^\d+$/) {
|
|
|
1025 |
my($bps) = $creator->get_baseprojs();
|
|
|
1026 |
push(@$bps, split(/\s+/, $impl));
|
|
|
1027 |
$restore = 1;
|
|
|
1028 |
$self->{'cacheok'} = 0;
|
|
|
1029 |
}
|
|
|
1030 |
}
|
|
|
1031 |
|
|
|
1032 |
## Generate the key for this project file
|
|
|
1033 |
my($prkey) = $self->getcwd() . '/' .
|
|
|
1034 |
($file eq '' ? $dir : $file) . "-$postkey";
|
|
|
1035 |
|
|
|
1036 |
## We must change to the subdirectory for
|
|
|
1037 |
## which this project file is intended
|
|
|
1038 |
if ($self->cd($dir)) {
|
|
|
1039 |
my($files_written) = [];
|
|
|
1040 |
my($gen_proj_info) = [];
|
|
|
1041 |
my($gen_lib_locs) = {};
|
|
|
1042 |
if ($self->{'cacheok'} && defined $allprojects{$prkey}) {
|
|
|
1043 |
$files_written = $allprojects{$prkey};
|
|
|
1044 |
$gen_proj_info = $allprinfo{$prkey};
|
|
|
1045 |
$gen_lib_locs = $allliblocs{$prkey};
|
|
|
1046 |
$status = 1;
|
|
|
1047 |
}
|
|
|
1048 |
else {
|
|
|
1049 |
$status = $creator->generate(basename($file));
|
|
|
1050 |
|
|
|
1051 |
## If any one project file fails, then stop
|
|
|
1052 |
## processing altogether.
|
|
|
1053 |
if (!$status) {
|
|
|
1054 |
## We don't restore the state before we leave,
|
|
|
1055 |
## but that's ok since we will be exiting soon.
|
|
|
1056 |
return $status, $creator;
|
|
|
1057 |
}
|
|
|
1058 |
|
|
|
1059 |
## Get the individual project information and
|
|
|
1060 |
## generated file name(s)
|
|
|
1061 |
$files_written = $creator->get_files_written();
|
|
|
1062 |
$gen_proj_info = $creator->get_project_info();
|
|
|
1063 |
$gen_lib_locs = $creator->get_lib_locations();
|
|
|
1064 |
|
|
|
1065 |
if ($self->{'cacheok'}) {
|
|
|
1066 |
$allprojects{$prkey} = $files_written;
|
|
|
1067 |
$allprinfo{$prkey} = $gen_proj_info;
|
|
|
1068 |
$allliblocs{$prkey} = $gen_lib_locs;
|
|
|
1069 |
}
|
|
|
1070 |
}
|
|
|
1071 |
$self->cd($cwd);
|
|
|
1072 |
$self->save_project_info($files_written, $gen_proj_info,
|
|
|
1073 |
$gen_lib_locs, $dir,
|
|
|
1074 |
\@projects, \%pi, \%liblocs);
|
|
|
1075 |
}
|
|
|
1076 |
else {
|
|
|
1077 |
## Unable to change to the directory.
|
|
|
1078 |
## We don't restore the state before we leave,
|
|
|
1079 |
## but that's ok since we will be exiting soon.
|
|
|
1080 |
return 0, $creator;
|
|
|
1081 |
}
|
|
|
1082 |
|
|
|
1083 |
## Return things to the way they were
|
|
|
1084 |
if (defined $self->{'scoped_assign'}->{$ofile}) {
|
|
|
1085 |
$impl = $previmpl;
|
|
|
1086 |
}
|
|
|
1087 |
if ($restore) {
|
|
|
1088 |
$self->{'cacheok'} = $prevcache;
|
|
|
1089 |
$creator->restore_state(\%gstate);
|
|
|
1090 |
}
|
|
|
1091 |
}
|
|
|
1092 |
else {
|
|
|
1093 |
## This one was excluded, so status is ok
|
|
|
1094 |
$status = 1;
|
|
|
1095 |
}
|
|
|
1096 |
}
|
|
|
1097 |
|
|
|
1098 |
## Add implict project dependencies based on source files
|
|
|
1099 |
## that have been used by multiple projects. If we do it here
|
|
|
1100 |
## before we call generate_hierarchy(), we don't have to call it
|
|
|
1101 |
## in generate_hierarchy() for each workspace.
|
|
|
1102 |
$self->{'projects'} = \@projects;
|
|
|
1103 |
$self->{'project_info'} = \%pi;
|
|
|
1104 |
if ($status && $genimpdep) {
|
|
|
1105 |
$self->add_implicit_project_dependencies($creator, $cwd);
|
|
|
1106 |
}
|
|
|
1107 |
|
|
|
1108 |
## If we are generating the hierarchical workspaces, then do so
|
|
|
1109 |
$self->{'lib_locations'} = \%liblocs;
|
|
|
1110 |
if ($self->get_hierarchy() || $self->workspace_per_project()) {
|
|
|
1111 |
my($orig) = $self->{'workspace_name'};
|
|
|
1112 |
$self->generate_hierarchy($creator, \@projects, \%pi);
|
|
|
1113 |
$self->{'workspace_name'} = $orig;
|
|
|
1114 |
}
|
|
|
1115 |
|
|
|
1116 |
## Reset the projects and project_info
|
|
|
1117 |
$self->{'projects'} = \@projects;
|
|
|
1118 |
$self->{'project_info'} = \%pi;
|
|
|
1119 |
|
|
|
1120 |
return $status, $creator;
|
|
|
1121 |
}
|
|
|
1122 |
|
|
|
1123 |
|
|
|
1124 |
sub array_contains {
|
|
|
1125 |
my($self) = shift;
|
|
|
1126 |
my($left) = shift;
|
|
|
1127 |
my($right) = shift;
|
|
|
1128 |
my(%check) = ();
|
|
|
1129 |
|
|
|
1130 |
## Initialize the hash keys with the left side array
|
|
|
1131 |
@check{@$left} = ();
|
|
|
1132 |
|
|
|
1133 |
## Check each element on the right against the left.
|
|
|
1134 |
foreach my $r (@$right) {
|
|
|
1135 |
if (exists $check{$r}) {
|
|
|
1136 |
return 1;
|
|
|
1137 |
}
|
|
|
1138 |
}
|
|
|
1139 |
|
|
|
1140 |
return 0;
|
|
|
1141 |
}
|
|
|
1142 |
|
|
|
1143 |
|
|
|
1144 |
sub non_intersection {
|
|
|
1145 |
my($self) = shift;
|
|
|
1146 |
my($left) = shift;
|
|
|
1147 |
my($right) = shift;
|
|
|
1148 |
my($over) = shift;
|
|
|
1149 |
my($status) = 0;
|
|
|
1150 |
my(%check) = ();
|
|
|
1151 |
|
|
|
1152 |
## Initialize the hash keys with the left side array
|
|
|
1153 |
@check{@$left} = ();
|
|
|
1154 |
|
|
|
1155 |
## Check each element on the right against the left.
|
|
|
1156 |
## Store anything that isn't in the left side in the over array.
|
|
|
1157 |
foreach my $r (@$right) {
|
|
|
1158 |
if (exists $check{$r}) {
|
|
|
1159 |
$status = 1;
|
|
|
1160 |
}
|
|
|
1161 |
else {
|
|
|
1162 |
push(@$over, $r);
|
|
|
1163 |
}
|
|
|
1164 |
}
|
|
|
1165 |
return $status;
|
|
|
1166 |
}
|
|
|
1167 |
|
|
|
1168 |
|
|
|
1169 |
sub indirect_depdency {
|
|
|
1170 |
my($self) = shift;
|
|
|
1171 |
my($dir) = shift;
|
|
|
1172 |
my($ccheck) = shift;
|
|
|
1173 |
my($cfile) = shift;
|
|
|
1174 |
|
|
|
1175 |
if ($self->{'project_info'}->{$ccheck}->[1] =~ /$cfile/) {
|
|
|
1176 |
return 1;
|
|
|
1177 |
}
|
|
|
1178 |
else {
|
|
|
1179 |
my($deps) = $self->create_array(
|
|
|
1180 |
$self->{'project_info'}->{$ccheck}->[1]);
|
|
|
1181 |
foreach my $dep (@$deps) {
|
|
|
1182 |
if (defined $self->{'project_info'}->{"$dir$dep"} &&
|
|
|
1183 |
$self->indirect_depdency($dir, "$dir$dep", $cfile)) {
|
|
|
1184 |
return 1;
|
|
|
1185 |
}
|
|
|
1186 |
}
|
|
|
1187 |
}
|
|
|
1188 |
|
|
|
1189 |
return 0;
|
|
|
1190 |
}
|
|
|
1191 |
|
|
|
1192 |
|
|
|
1193 |
sub add_implicit_project_dependencies {
|
|
|
1194 |
my($self) = shift;
|
|
|
1195 |
my($creator) = shift;
|
|
|
1196 |
my($cwd) = shift;
|
|
|
1197 |
my(%bidir) = ();
|
|
|
1198 |
my(%save) = ();
|
|
|
1199 |
|
|
|
1200 |
## Take the current working directory and regular expression'ize it.
|
|
|
1201 |
$cwd = $self->escape_regex_special($cwd);
|
|
|
1202 |
|
|
|
1203 |
## Look at each projects file list and check it against all of the
|
|
|
1204 |
## others. If any of the other projects file lists contains anothers
|
|
|
1205 |
## file, then they are dependent (due to build parallelism). So, we
|
|
|
1206 |
## append the dependency and remove the file in question from the
|
|
|
1207 |
## project so that the next time around the foreach, we don't find it
|
|
|
1208 |
## as a dependent on the one that we just modified.
|
|
|
1209 |
my(@pflkeys) = keys %{$self->{'project_file_list'}};
|
|
|
1210 |
foreach my $key (@pflkeys) {
|
|
|
1211 |
foreach my $ikey (@pflkeys) {
|
|
|
1212 |
## Not the same project and
|
|
|
1213 |
## The same directory and
|
|
|
1214 |
## We've not already added a dependency to this project
|
|
|
1215 |
if ($key ne $ikey &&
|
|
|
1216 |
($self->{'project_file_list'}->{$key}->[1] eq
|
|
|
1217 |
$self->{'project_file_list'}->{$ikey}->[1]) &&
|
|
|
1218 |
(!defined $bidir{$ikey} ||
|
|
|
1219 |
!$self->array_contains($bidir{$ikey}, [$key]))) {
|
|
|
1220 |
my(@over) = ();
|
|
|
1221 |
if ($self->non_intersection(
|
|
|
1222 |
$self->{'project_file_list'}->{$key}->[2],
|
|
|
1223 |
$self->{'project_file_list'}->{$ikey}->[2],
|
|
|
1224 |
\@over)) {
|
|
|
1225 |
## The project contains shared source files, so we need to
|
|
|
1226 |
## look into adding an implicit inter-project dependency.
|
|
|
1227 |
$save{$ikey} = $self->{'project_file_list'}->{$ikey}->[2];
|
|
|
1228 |
$self->{'project_file_list'}->{$ikey}->[2] = \@over;
|
|
|
1229 |
if (defined $bidir{$key}) {
|
|
|
1230 |
push(@{$bidir{$key}}, $ikey);
|
|
|
1231 |
}
|
|
|
1232 |
else {
|
|
|
1233 |
$bidir{$key} = [$ikey];
|
|
|
1234 |
}
|
|
|
1235 |
my($append) = $creator->translate_value('after', $key);
|
|
|
1236 |
my($file) = $self->{'project_file_list'}->{$ikey}->[0];
|
|
|
1237 |
my($dir) = $self->{'project_file_list'}->{$ikey}->[1];
|
|
|
1238 |
my($cfile) = $self->escape_regex_special(
|
|
|
1239 |
$creator->translate_value('after', $ikey));
|
|
|
1240 |
## Remove our starting directory from the projects directory
|
|
|
1241 |
## to get the right part of the directory to prepend.
|
|
|
1242 |
$dir =~ s/^$cwd[\/\\]*//;
|
|
|
1243 |
|
|
|
1244 |
## Turn the append value into a key for 'project_info' and
|
|
|
1245 |
## prepend the directory to the file.
|
|
|
1246 |
my($ccheck) = $append;
|
|
|
1247 |
$ccheck =~ s/"//g;
|
|
|
1248 |
if ($dir ne '') {
|
|
|
1249 |
$dir .= '/';
|
|
|
1250 |
$ccheck = "$dir$ccheck";
|
|
|
1251 |
$file = "$dir$file";
|
|
|
1252 |
}
|
|
|
1253 |
|
|
|
1254 |
## If the append value key contains a reference to the project
|
|
|
1255 |
## that we were going to append the dependency value, then
|
|
|
1256 |
## ignore the generated dependency. It is redundant and
|
|
|
1257 |
## quite possibly wrong.
|
|
|
1258 |
if (!defined $self->{'project_info'}->{$ccheck} ||
|
|
|
1259 |
!$self->indirect_depdency($dir, $ccheck, $cfile)) {
|
|
|
1260 |
## Append the dependency
|
|
|
1261 |
$self->{'project_info'}->{$file}->[1] .= " $append";
|
|
|
1262 |
}
|
|
|
1263 |
}
|
|
|
1264 |
}
|
|
|
1265 |
}
|
|
|
1266 |
}
|
|
|
1267 |
|
|
|
1268 |
## Restore the modified values in case this method is called again
|
|
|
1269 |
## which is the case when using the -hierarchy option.
|
|
|
1270 |
foreach my $skey (keys %save) {
|
|
|
1271 |
$self->{'project_file_list'}->{$skey}->[2] = $save{$skey};
|
|
|
1272 |
}
|
|
|
1273 |
}
|
|
|
1274 |
|
|
|
1275 |
|
|
|
1276 |
sub get_projects {
|
|
|
1277 |
my($self) = shift;
|
|
|
1278 |
return $self->{'projects'};
|
|
|
1279 |
}
|
|
|
1280 |
|
|
|
1281 |
|
|
|
1282 |
sub get_project_info {
|
|
|
1283 |
my($self) = shift;
|
|
|
1284 |
return $self->{'project_info'};
|
|
|
1285 |
}
|
|
|
1286 |
|
|
|
1287 |
|
|
|
1288 |
sub get_lib_locations {
|
|
|
1289 |
my($self) = shift;
|
|
|
1290 |
return $self->{'lib_locations'};
|
|
|
1291 |
}
|
|
|
1292 |
|
|
|
1293 |
|
|
|
1294 |
sub get_first_level_directory {
|
|
|
1295 |
my($self) = shift;
|
|
|
1296 |
my($file) = shift;
|
|
|
1297 |
my($dir) = undef;
|
|
|
1298 |
if (($file =~ tr/\///) > 0) {
|
|
|
1299 |
$dir = $file;
|
|
|
1300 |
$dir =~ s/^([^\/]+\/).*/$1/;
|
|
|
1301 |
$dir =~ s/\/+$//;
|
|
|
1302 |
}
|
|
|
1303 |
else {
|
|
|
1304 |
$dir = '.';
|
|
|
1305 |
}
|
|
|
1306 |
return $dir;
|
|
|
1307 |
}
|
|
|
1308 |
|
|
|
1309 |
|
|
|
1310 |
sub sort_within_group {
|
|
|
1311 |
my($self) = shift;
|
|
|
1312 |
my($list) = shift;
|
|
|
1313 |
my($start) = shift;
|
|
|
1314 |
my($end) = shift;
|
|
|
1315 |
my($deps) = undef;
|
|
|
1316 |
my($ccount) = 0;
|
|
|
1317 |
my($cmax) = ($end - $start) + 1;
|
|
|
1318 |
my($previ) = -1;
|
|
|
1319 |
my($prevpjs) = [];
|
|
|
1320 |
my($movepjs) = [];
|
|
|
1321 |
|
|
|
1322 |
## Put the projects in the order specified
|
|
|
1323 |
## by the project dpendencies.
|
|
|
1324 |
for(my $i = $start; $i <= $end; ++$i) {
|
|
|
1325 |
## If our moved project equals our previously moved project then
|
|
|
1326 |
## we count this as a possible circular dependency.
|
|
|
1327 |
if (defined $$movepjs[0] && defined $$prevpjs[0] &&
|
|
|
1328 |
$$movepjs[0] == $$prevpjs[0] && $$movepjs[1] == $$prevpjs[1]) {
|
|
|
1329 |
++$ccount;
|
|
|
1330 |
}
|
|
|
1331 |
else {
|
|
|
1332 |
$ccount = 0;
|
|
|
1333 |
}
|
|
|
1334 |
|
|
|
1335 |
## Detect circular dependencies
|
|
|
1336 |
if ($ccount > $cmax) {
|
|
|
1337 |
my(@prjs) = ();
|
|
|
1338 |
foreach my $mvgr (@$movepjs) {
|
|
|
1339 |
push(@prjs, $$list[$mvgr]);
|
|
|
1340 |
}
|
|
|
1341 |
my($other) = $$movepjs[0] - 1;
|
|
|
1342 |
if ($other < $start || $other == $$movepjs[1] || !defined $$list[$other]) {
|
|
|
1343 |
$other = undef;
|
|
|
1344 |
}
|
|
|
1345 |
$self->warning('Circular dependency detected while processing the ' .
|
|
|
1346 |
($self->{'current_input'} eq '' ?
|
|
|
1347 |
'default' : $self->{'current_input'}) .
|
|
|
1348 |
' workspace. ' .
|
|
|
1349 |
'The following projects are involved: ' .
|
|
|
1350 |
(defined $other ? "$$list[$other], " : '') .
|
|
|
1351 |
join(' and ', @prjs));
|
|
|
1352 |
return;
|
|
|
1353 |
}
|
|
|
1354 |
|
|
|
1355 |
## Keep track of the previous project movement
|
|
|
1356 |
$prevpjs = $movepjs;
|
|
|
1357 |
if ($previ < $i) {
|
|
|
1358 |
$movepjs = [];
|
|
|
1359 |
}
|
|
|
1360 |
$previ = $i;
|
|
|
1361 |
|
|
|
1362 |
$deps = $self->get_validated_ordering($$list[$i]);
|
|
|
1363 |
if ($deps ne '') {
|
|
|
1364 |
my($baseproj) = basename($$list[$i]);
|
|
|
1365 |
my($darr) = $self->create_array($deps);
|
|
|
1366 |
|
|
|
1367 |
my($moved) = 0;
|
|
|
1368 |
foreach my $dep (@$darr) {
|
|
|
1369 |
if ($baseproj ne $dep) {
|
|
|
1370 |
## See if the dependency is listed after this project
|
|
|
1371 |
for(my $j = $i + 1; $j <= $end; ++$j) {
|
|
|
1372 |
if (basename($$list[$j]) eq $dep) {
|
|
|
1373 |
$movepjs = [$i, $j];
|
|
|
1374 |
## If so, move it in front of the current project.
|
|
|
1375 |
## The original code, which had splices, didn't always
|
|
|
1376 |
## work correctly (especially on AIX for some reason).
|
|
|
1377 |
my($save) = $$list[$j];
|
|
|
1378 |
for(my $k = $j; $k > $i; --$k) {
|
|
|
1379 |
$$list[$k] = $$list[$k - 1];
|
|
|
1380 |
}
|
|
|
1381 |
$$list[$i] = $save;
|
|
|
1382 |
|
|
|
1383 |
## Mark that an entry has been moved
|
|
|
1384 |
$moved = 1;
|
|
|
1385 |
$j--;
|
|
|
1386 |
}
|
|
|
1387 |
}
|
|
|
1388 |
}
|
|
|
1389 |
}
|
|
|
1390 |
if ($moved) {
|
|
|
1391 |
$i--;
|
|
|
1392 |
}
|
|
|
1393 |
}
|
|
|
1394 |
}
|
|
|
1395 |
}
|
|
|
1396 |
|
|
|
1397 |
|
|
|
1398 |
sub sort_by_groups {
|
|
|
1399 |
my($self) = shift;
|
|
|
1400 |
my($list) = shift;
|
|
|
1401 |
my($grindex) = shift;
|
|
|
1402 |
my(@groups) = @$grindex;
|
|
|
1403 |
my($ccount) = 0;
|
|
|
1404 |
my($cmax) = $#groups;
|
|
|
1405 |
my($prevgi) = -1;
|
|
|
1406 |
my($prevgrs) = [];
|
|
|
1407 |
my($movegrs) = [];
|
|
|
1408 |
|
|
|
1409 |
for(my $gi = 0; $gi <= $#groups; ++$gi) {
|
|
|
1410 |
## If our moved group equals our previously moved group then
|
|
|
1411 |
## we count this as a possible circular dependency.
|
|
|
1412 |
if (defined $$movegrs[0] && defined $$prevgrs[0] &&
|
|
|
1413 |
$$movegrs[0] == $$prevgrs[0] && $$movegrs[1] == $$prevgrs[1]) {
|
|
|
1414 |
++$ccount;
|
|
|
1415 |
}
|
|
|
1416 |
else {
|
|
|
1417 |
$ccount = 0;
|
|
|
1418 |
}
|
|
|
1419 |
|
|
|
1420 |
## Detect circular dependencies
|
|
|
1421 |
if ($ccount > $cmax) {
|
|
|
1422 |
my(@dirs) = ();
|
|
|
1423 |
foreach my $mvgr (@$movegrs) {
|
|
|
1424 |
push(@dirs, $$list[$groups[$mvgr]->[0]]);
|
|
|
1425 |
$dirs[$#dirs] =~ s/[\/\\].*//;
|
|
|
1426 |
}
|
|
|
1427 |
$self->warning('Circular dependency detected while processing the ' .
|
|
|
1428 |
($self->{'current_input'} eq '' ?
|
|
|
1429 |
'default' : $self->{'current_input'}) .
|
|
|
1430 |
' workspace. ' .
|
|
|
1431 |
'The following directories are involved: ' .
|
|
|
1432 |
join(' and ', @dirs));
|
|
|
1433 |
return;
|
|
|
1434 |
}
|
|
|
1435 |
|
|
|
1436 |
## Build up the group dependencies
|
|
|
1437 |
my(%gdeps) = ();
|
|
|
1438 |
for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
|
|
|
1439 |
my($deps) = $self->get_validated_ordering($$list[$i]);
|
|
|
1440 |
if ($deps ne '') {
|
|
|
1441 |
my($darr) = $self->create_array($deps);
|
|
|
1442 |
foreach my $dep (@$darr) {
|
|
|
1443 |
$gdeps{$dep} = 1;
|
|
|
1444 |
}
|
|
|
1445 |
}
|
|
|
1446 |
}
|
|
|
1447 |
|
|
|
1448 |
## Keep track of the previous group movement
|
|
|
1449 |
$prevgrs = $movegrs;
|
|
|
1450 |
if ($prevgi < $gi) {
|
|
|
1451 |
$movegrs = [];
|
|
|
1452 |
}
|
|
|
1453 |
$prevgi = $gi;
|
|
|
1454 |
|
|
|
1455 |
## Search the rest of the groups for any of the group dependencies
|
|
|
1456 |
my($moved) = 0;
|
|
|
1457 |
for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) {
|
|
|
1458 |
for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) {
|
|
|
1459 |
if (defined $gdeps{basename($$list[$i])}) {
|
|
|
1460 |
## Move this group ($gj) in front of the current group ($gi)
|
|
|
1461 |
$movegrs = [$gj, $gi];
|
|
|
1462 |
my(@save) = ();
|
|
|
1463 |
for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) {
|
|
|
1464 |
push(@save, $$list[$j]);
|
|
|
1465 |
}
|
|
|
1466 |
my($offset) = $groups[$gj]->[1] - $groups[$gi]->[1];
|
|
|
1467 |
for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) {
|
|
|
1468 |
$$list[$j + $offset] = $$list[$j];
|
|
|
1469 |
}
|
|
|
1470 |
for(my $j = 0; $j <= $#save; ++$j) {
|
|
|
1471 |
$$list[$groups[$gi]->[0] + $j] = $save[$j];
|
|
|
1472 |
}
|
|
|
1473 |
|
|
|
1474 |
## Update the group indices
|
|
|
1475 |
my($shiftamt) = ($groups[$gi]->[1] - $groups[$gi]->[0]) + 1;
|
|
|
1476 |
for(my $j = $gi + 1; $j <= $gj; ++$j) {
|
|
|
1477 |
$groups[$j]->[0] -= $shiftamt;
|
|
|
1478 |
$groups[$j]->[1] -= $shiftamt;
|
|
|
1479 |
}
|
|
|
1480 |
my(@grsave) = @{$groups[$gi]};
|
|
|
1481 |
$grsave[0] += $offset;
|
|
|
1482 |
$grsave[1] += $offset;
|
|
|
1483 |
for(my $j = $gi; $j < $gj; ++$j) {
|
|
|
1484 |
$groups[$j] = $groups[$j + 1];
|
|
|
1485 |
}
|
|
|
1486 |
$groups[$gj] = \@grsave;
|
|
|
1487 |
|
|
|
1488 |
## Signify that we have moved a group
|
|
|
1489 |
$moved = 1;
|
|
|
1490 |
last;
|
|
|
1491 |
}
|
|
|
1492 |
}
|
|
|
1493 |
if ($moved) {
|
|
|
1494 |
## Start over from the first group
|
|
|
1495 |
$gi = -1;
|
|
|
1496 |
last;
|
|
|
1497 |
}
|
|
|
1498 |
}
|
|
|
1499 |
}
|
|
|
1500 |
}
|
|
|
1501 |
|
|
|
1502 |
|
|
|
1503 |
sub sort_dependencies {
|
|
|
1504 |
my($self) = shift;
|
|
|
1505 |
my($projects) = shift;
|
|
|
1506 |
my(@list) = sort @$projects;
|
|
|
1507 |
|
|
|
1508 |
## Put the projects in the order specified
|
|
|
1509 |
## by the project dpendencies. We only need to do
|
|
|
1510 |
## this if there is more than one element in the array.
|
|
|
1511 |
if ($#list > 0) {
|
|
|
1512 |
## First determine the individual groups
|
|
|
1513 |
my(@grindex) = ();
|
|
|
1514 |
my($previous) = [0, undef];
|
|
|
1515 |
for(my $li = 0; $li <= $#list; ++$li) {
|
|
|
1516 |
my($dir) = $self->get_first_level_directory($list[$li]);
|
|
|
1517 |
if (!defined $previous->[1]) {
|
|
|
1518 |
$previous = [$li, $dir];
|
|
|
1519 |
}
|
|
|
1520 |
elsif ($previous->[1] ne $dir) {
|
|
|
1521 |
push(@grindex, [$previous->[0], $li - 1]);
|
|
|
1522 |
$previous = [$li, $dir];
|
|
|
1523 |
}
|
|
|
1524 |
}
|
|
|
1525 |
push(@grindex, [$previous->[0], $#list]);
|
|
|
1526 |
|
|
|
1527 |
## Next, sort the individual groups
|
|
|
1528 |
foreach my $gr (@grindex) {
|
|
|
1529 |
if ($$gr[0] != $$gr[1]) {
|
|
|
1530 |
$self->sort_within_group(\@list, @$gr);
|
|
|
1531 |
}
|
|
|
1532 |
}
|
|
|
1533 |
|
|
|
1534 |
## Now sort the groups as single entities
|
|
|
1535 |
if ($#grindex > 0) {
|
|
|
1536 |
$self->sort_by_groups(\@list, \@grindex);
|
|
|
1537 |
}
|
|
|
1538 |
}
|
|
|
1539 |
|
|
|
1540 |
return @list;
|
|
|
1541 |
}
|
|
|
1542 |
|
|
|
1543 |
|
|
|
1544 |
sub number_target_deps {
|
|
|
1545 |
my($self) = shift;
|
|
|
1546 |
my($projects) = shift;
|
|
|
1547 |
my($pjs) = shift;
|
|
|
1548 |
my($targets) = shift;
|
|
|
1549 |
my(@list) = $self->sort_dependencies($projects);
|
|
|
1550 |
|
|
|
1551 |
## This block of code must be done after the list of dependencies
|
|
|
1552 |
## has been sorted in order to get the correct project numbers.
|
|
|
1553 |
for(my $i = 0; $i <= $#list; ++$i) {
|
|
|
1554 |
my($project) = $list[$i];
|
|
|
1555 |
if (defined $$pjs{$project}) {
|
|
|
1556 |
my($name, $deps) = @{$$pjs{$project}};
|
|
|
1557 |
if (defined $deps && $deps ne '') {
|
|
|
1558 |
my(%targetnumbers) = ();
|
|
|
1559 |
my($darr) = $self->create_array($deps);
|
|
|
1560 |
|
|
|
1561 |
## For each dependency, search in the sorted list
|
|
|
1562 |
## up to the point of this project for the projects
|
|
|
1563 |
## that this one depends on. When the project is
|
|
|
1564 |
## found, we put the target number in a hash map (to avoid
|
|
|
1565 |
## duplicates).
|
|
|
1566 |
foreach my $dep (@$darr) {
|
|
|
1567 |
for(my $j = 0; $j < $i; ++$j) {
|
|
|
1568 |
if (basename($list[$j]) eq $dep) {
|
|
|
1569 |
$targetnumbers{$j} = 1;
|
|
|
1570 |
}
|
|
|
1571 |
}
|
|
|
1572 |
}
|
|
|
1573 |
|
|
|
1574 |
## Get the keys of the hash map and store the
|
|
|
1575 |
## array in the hash keyed on the project file.
|
|
|
1576 |
my(@numbers) = sort { $a <=> $b } keys %targetnumbers;
|
|
|
1577 |
if (defined $numbers[0]) {
|
|
|
1578 |
$$targets{$project} = \@numbers;
|
|
|
1579 |
}
|
|
|
1580 |
}
|
|
|
1581 |
}
|
|
|
1582 |
}
|
|
|
1583 |
|
|
|
1584 |
return @list;
|
|
|
1585 |
}
|
|
|
1586 |
|
|
|
1587 |
|
|
|
1588 |
sub project_target_translation {
|
|
|
1589 |
my($self) = shift;
|
|
|
1590 |
my($cased) = shift;
|
|
|
1591 |
my(%map) = ();
|
|
|
1592 |
|
|
|
1593 |
## Translate project names to avoid target collision with
|
|
|
1594 |
## some versions of make.
|
|
|
1595 |
foreach my $key (keys %{$self->{'project_info'}}) {
|
|
|
1596 |
my($dir) = $self->mpc_dirname($key);
|
|
|
1597 |
my($name) = $self->{'project_info'}->{$key}->[0];
|
|
|
1598 |
|
|
|
1599 |
if (($cased && $dir eq $name) || (!$cased && lc($dir) eq lc($name))) {
|
|
|
1600 |
$map{$key} = "$name-target";
|
|
|
1601 |
}
|
|
|
1602 |
else {
|
|
|
1603 |
$map{$key} = $name;
|
|
|
1604 |
}
|
|
|
1605 |
}
|
|
|
1606 |
return \%map;
|
|
|
1607 |
}
|
|
|
1608 |
|
|
|
1609 |
|
|
|
1610 |
sub optionError {
|
|
|
1611 |
my($self) = shift;
|
|
|
1612 |
my($str) = shift;
|
|
|
1613 |
$self->warning("$self->{'current_input'}: $str.");
|
|
|
1614 |
}
|
|
|
1615 |
|
|
|
1616 |
|
|
|
1617 |
sub process_cmdline {
|
|
|
1618 |
my($self) = shift;
|
|
|
1619 |
my($cmdline) = shift;
|
|
|
1620 |
my($parameters) = shift;
|
|
|
1621 |
|
|
|
1622 |
## It's ok to use the cache
|
|
|
1623 |
$self->{'cacheok'} = 1;
|
|
|
1624 |
|
|
|
1625 |
if (defined $cmdline && $cmdline ne '') {
|
|
|
1626 |
my($args) = $self->create_array($cmdline);
|
|
|
1627 |
|
|
|
1628 |
## Look for environment variables
|
|
|
1629 |
foreach my $arg (@$args) {
|
|
|
1630 |
while($arg =~ /\$(\w+)/) {
|
|
|
1631 |
my($name) = $1;
|
|
|
1632 |
my($val) = '';
|
|
|
1633 |
if ($name eq 'PWD') {
|
|
|
1634 |
$val = $self->getcwd();
|
|
|
1635 |
}
|
|
|
1636 |
elsif (defined $ENV{$name}) {
|
|
|
1637 |
$val = $ENV{$name};
|
|
|
1638 |
}
|
|
|
1639 |
$arg =~ s/\$\w+/$val/;
|
|
|
1640 |
}
|
|
|
1641 |
}
|
|
|
1642 |
|
|
|
1643 |
my($options) = $self->options('MWC', {}, 0, @$args);
|
|
|
1644 |
if (defined $options) {
|
|
|
1645 |
foreach my $key (keys %$options) {
|
|
|
1646 |
my($type) = $self->is_set($key, $options);
|
|
|
1647 |
|
|
|
1648 |
if (!defined $type) {
|
|
|
1649 |
## This option was not used, so we ignore it
|
|
|
1650 |
}
|
|
|
1651 |
elsif ($type eq 'ARRAY') {
|
|
|
1652 |
push(@{$parameters->{$key}}, @{$options->{$key}});
|
|
|
1653 |
}
|
|
|
1654 |
elsif ($type eq 'HASH') {
|
|
|
1655 |
foreach my $hk (keys %{$options->{$key}}) {
|
|
|
1656 |
$parameters->{$key}->{$hk} = $options->{$key}->{$hk};
|
|
|
1657 |
}
|
|
|
1658 |
}
|
|
|
1659 |
elsif ($type eq 'SCALAR') {
|
|
|
1660 |
$parameters->{$key} = $options->{$key};
|
|
|
1661 |
}
|
|
|
1662 |
}
|
|
|
1663 |
|
|
|
1664 |
## Issue warnings for these options
|
|
|
1665 |
if (defined $options->{'recurse'}) {
|
|
|
1666 |
$self->optionError('-recurse is ignored');
|
|
|
1667 |
}
|
|
|
1668 |
if (defined $options->{'reldefs'}) {
|
|
|
1669 |
$self->optionError('-noreldefs is ignored');
|
|
|
1670 |
}
|
|
|
1671 |
if (defined $options->{'coexistence'}) {
|
|
|
1672 |
$self->optionError('-make_coexistence is ignored');
|
|
|
1673 |
}
|
|
|
1674 |
if (defined $options->{'genins'}) {
|
|
|
1675 |
$self->optionError('-genins is ignored');
|
|
|
1676 |
}
|
|
|
1677 |
if (defined $options->{'into'}) {
|
|
|
1678 |
$self->optionError('-into is ignored');
|
|
|
1679 |
}
|
|
|
1680 |
if (defined $options->{'language'}) {
|
|
|
1681 |
$self->optionError('-language is ignored');
|
|
|
1682 |
}
|
|
|
1683 |
if (defined $options->{'input'}->[0]) {
|
|
|
1684 |
$self->optionError('Command line files ' .
|
|
|
1685 |
'specified in a workspace are ignored');
|
|
|
1686 |
}
|
|
|
1687 |
|
|
|
1688 |
## Determine if it's ok to use the cache
|
|
|
1689 |
my(@cacheInvalidating) = ('global', 'include', 'baseprojs',
|
|
|
1690 |
'template', 'ti', 'relative',
|
|
|
1691 |
'addtemp', 'addproj', 'feature_file',
|
|
|
1692 |
'features', 'use_env', 'expand_vars');
|
|
|
1693 |
foreach my $key (@cacheInvalidating) {
|
|
|
1694 |
if ($self->is_set($key, $options)) {
|
|
|
1695 |
$self->{'cacheok'} = 0;
|
|
|
1696 |
last;
|
|
|
1697 |
}
|
|
|
1698 |
}
|
|
|
1699 |
}
|
|
|
1700 |
}
|
|
|
1701 |
}
|
|
|
1702 |
|
|
|
1703 |
|
|
|
1704 |
sub current_parameters {
|
|
|
1705 |
my($self) = shift;
|
|
|
1706 |
my(%parameters) = $self->save_state();
|
|
|
1707 |
|
|
|
1708 |
## We always want the project creator to generate a toplevel
|
|
|
1709 |
$parameters{'toplevel'} = 1;
|
|
|
1710 |
return %parameters;
|
|
|
1711 |
}
|
|
|
1712 |
|
|
|
1713 |
|
|
|
1714 |
sub project_creator {
|
|
|
1715 |
my($self) = shift;
|
|
|
1716 |
my($str) = "$self";
|
|
|
1717 |
|
|
|
1718 |
## NOTE: If the subclassed WorkspaceCreator name prefix does not
|
|
|
1719 |
## match the name prefix of the ProjectCreator, this code
|
|
|
1720 |
## will not work and the subclassed WorkspaceCreator will
|
|
|
1721 |
## need to override this method.
|
|
|
1722 |
|
|
|
1723 |
$str =~ s/Workspace/Project/;
|
|
|
1724 |
$str =~ s/=HASH.*//;
|
|
|
1725 |
|
|
|
1726 |
## Set up values for each project creator
|
|
|
1727 |
## If we have command line arguments in the workspace, then
|
|
|
1728 |
## we process them before creating the project creator
|
|
|
1729 |
my($cmdline) = $self->get_assignment('cmdline');
|
|
|
1730 |
my(%parameters) = $self->current_parameters();
|
|
|
1731 |
$self->process_cmdline($cmdline, \%parameters);
|
|
|
1732 |
|
|
|
1733 |
## Create the new project creator with the updated parameters
|
|
|
1734 |
return $str->new($parameters{'global'},
|
|
|
1735 |
$parameters{'include'},
|
|
|
1736 |
$parameters{'template'},
|
|
|
1737 |
$parameters{'ti'},
|
|
|
1738 |
$parameters{'dynamic'},
|
|
|
1739 |
$parameters{'static'},
|
|
|
1740 |
$parameters{'relative'},
|
|
|
1741 |
$parameters{'addtemp'},
|
|
|
1742 |
$parameters{'addproj'},
|
|
|
1743 |
$parameters{'progress'},
|
|
|
1744 |
$parameters{'toplevel'},
|
|
|
1745 |
$parameters{'baseprojs'},
|
|
|
1746 |
$self->{'global_feature_file'},
|
|
|
1747 |
$parameters{'feature_file'},
|
|
|
1748 |
$parameters{'features'},
|
|
|
1749 |
$parameters{'hierarchy'},
|
|
|
1750 |
$self->{'exclude'}->{$self->{'wctype'}},
|
|
|
1751 |
$self->make_coexistence(),
|
|
|
1752 |
$parameters{'name_modifier'},
|
|
|
1753 |
$parameters{'apply_project'},
|
|
|
1754 |
$self->{'generate_ins'},
|
|
|
1755 |
$parameters{'into'},
|
|
|
1756 |
$self->get_language(),
|
|
|
1757 |
$parameters{'use_env'},
|
|
|
1758 |
$parameters{'expand_vars'});
|
|
|
1759 |
}
|
|
|
1760 |
|
|
|
1761 |
|
|
|
1762 |
sub sort_files {
|
|
|
1763 |
#my($self) = shift;
|
|
|
1764 |
return 0;
|
|
|
1765 |
}
|
|
|
1766 |
|
|
|
1767 |
|
|
|
1768 |
sub make_coexistence {
|
|
|
1769 |
my($self) = shift;
|
|
|
1770 |
return $self->{'coexistence'};
|
|
|
1771 |
}
|
|
|
1772 |
|
|
|
1773 |
|
|
|
1774 |
sub get_modified_workspace_name {
|
|
|
1775 |
my($self) = shift;
|
|
|
1776 |
my($name) = shift;
|
|
|
1777 |
my($ext) = shift;
|
|
|
1778 |
my($nows) = shift;
|
|
|
1779 |
my($nmod) = $self->get_name_modifier();
|
|
|
1780 |
|
|
|
1781 |
if (defined $nmod) {
|
|
|
1782 |
$nmod =~ s/\*/$name/g;
|
|
|
1783 |
$name = $nmod;
|
|
|
1784 |
}
|
|
|
1785 |
|
|
|
1786 |
## If this is a per project workspace, then we should not
|
|
|
1787 |
## modify the workspace name. It may overwrite another workspace
|
|
|
1788 |
## but that's ok, it will only be a per project workspace.
|
|
|
1789 |
## Also, if we don't want the workspace name attached ($nows) then
|
|
|
1790 |
## we just return the name plus the extension.
|
|
|
1791 |
if ($nows || $self->{'per_project_workspace_name'}) {
|
|
|
1792 |
return "$name$ext";
|
|
|
1793 |
}
|
|
|
1794 |
|
|
|
1795 |
my($pwd) = $self->getcwd();
|
|
|
1796 |
my($type) = $self->{'wctype'};
|
|
|
1797 |
my($wsname) = $self->get_workspace_name();
|
|
|
1798 |
|
|
|
1799 |
if (!defined $previous_workspace_name{$type}->{$pwd}) {
|
|
|
1800 |
$previous_workspace_name{$type}->{$pwd} = $wsname;
|
|
|
1801 |
$self->{'current_workspace_name'} = undef;
|
|
|
1802 |
}
|
|
|
1803 |
else {
|
|
|
1804 |
my($prefix) = ($name eq $wsname ? $name : "$name.$wsname");
|
|
|
1805 |
$previous_workspace_name{$type}->{$pwd} = $wsname;
|
|
|
1806 |
while($self->file_written("$prefix" .
|
|
|
1807 |
($self->{'modified_count'} > 0 ?
|
|
|
1808 |
".$self->{'modified_count'}" : '') .
|
|
|
1809 |
"$ext")) {
|
|
|
1810 |
++$self->{'modified_count'};
|
|
|
1811 |
}
|
|
|
1812 |
$self->{'current_workspace_name'} =
|
|
|
1813 |
"$prefix" . ($self->{'modified_count'} > 0 ?
|
|
|
1814 |
".$self->{'modified_count'}" : '') . "$ext";
|
|
|
1815 |
}
|
|
|
1816 |
|
|
|
1817 |
return (defined $self->{'current_workspace_name'} ?
|
|
|
1818 |
$self->{'current_workspace_name'} : "$name$ext");
|
|
|
1819 |
}
|
|
|
1820 |
|
|
|
1821 |
|
|
|
1822 |
sub generate_recursive_input_list {
|
|
|
1823 |
my($self) = shift;
|
|
|
1824 |
my($dir) = shift;
|
|
|
1825 |
my($exclude) = shift;
|
|
|
1826 |
return $self->extension_recursive_input_list($dir, $exclude, $wsext);
|
|
|
1827 |
}
|
|
|
1828 |
|
|
|
1829 |
|
|
|
1830 |
sub verify_build_ordering {
|
|
|
1831 |
my($self) = shift;
|
|
|
1832 |
foreach my $project (@{$self->{'projects'}}) {
|
|
|
1833 |
$self->get_validated_ordering($project);
|
|
|
1834 |
}
|
|
|
1835 |
}
|
|
|
1836 |
|
|
|
1837 |
|
|
|
1838 |
sub get_validated_ordering {
|
|
|
1839 |
my($self) = shift;
|
|
|
1840 |
my($project) = shift;
|
|
|
1841 |
my($deps) = undef;
|
|
|
1842 |
|
|
|
1843 |
if (defined $self->{'ordering_cache'}->{$project}) {
|
|
|
1844 |
$deps = $self->{'ordering_cache'}->{$project};
|
|
|
1845 |
}
|
|
|
1846 |
else {
|
|
|
1847 |
$deps = '';
|
|
|
1848 |
if (defined $self->{'project_info'}->{$project}) {
|
|
|
1849 |
my($name) = undef;
|
|
|
1850 |
($name, $deps) = @{$self->{'project_info'}->{$project}};
|
|
|
1851 |
if (defined $deps && $deps ne '') {
|
|
|
1852 |
my($darr) = $self->create_array($deps);
|
|
|
1853 |
foreach my $dep (@$darr) {
|
|
|
1854 |
my($found) = 0;
|
|
|
1855 |
## Avoid circular dependencies
|
|
|
1856 |
if ($dep ne $name && $dep ne basename($project)) {
|
|
|
1857 |
foreach my $p (@{$self->{'projects'}}) {
|
|
|
1858 |
if ($dep eq $self->{'project_info'}->{$p}->[0] ||
|
|
|
1859 |
$dep eq basename($p)) {
|
|
|
1860 |
$found = 1;
|
|
|
1861 |
last;
|
|
|
1862 |
}
|
|
|
1863 |
}
|
|
|
1864 |
if (!$found) {
|
|
|
1865 |
if (defined $ENV{MPC_VERBOSE_ORDERING}) {
|
|
|
1866 |
$self->warning("'$name' references '$dep' which has " .
|
|
|
1867 |
"not been processed.");
|
|
|
1868 |
}
|
|
|
1869 |
my($reg) = $self->escape_regex_special($dep);
|
|
|
1870 |
$deps =~ s/\s*"$reg"\s*/ /g;
|
|
|
1871 |
}
|
|
|
1872 |
}
|
|
|
1873 |
}
|
|
|
1874 |
|
|
|
1875 |
$deps =~ s/^\s+//;
|
|
|
1876 |
$deps =~ s/\s+$//;
|
|
|
1877 |
}
|
|
|
1878 |
|
|
|
1879 |
$self->{'ordering_cache'}->{$project} = $deps;
|
|
|
1880 |
}
|
|
|
1881 |
}
|
|
|
1882 |
|
|
|
1883 |
return $deps;
|
|
|
1884 |
}
|
|
|
1885 |
|
|
|
1886 |
|
|
|
1887 |
sub source_listing_callback {
|
|
|
1888 |
my($self) = shift;
|
|
|
1889 |
my($project_file) = shift;
|
|
|
1890 |
my($project_name) = shift;
|
|
|
1891 |
my(@files) = @_;
|
|
|
1892 |
my($cwd) = $self->getcwd();
|
|
|
1893 |
$self->{'project_file_list'}->{$project_name} = [ $project_file,
|
|
|
1894 |
$cwd, \@files ];
|
|
|
1895 |
}
|
|
|
1896 |
|
|
|
1897 |
# ************************************************************
|
|
|
1898 |
# Virtual Methods To Be Overridden
|
|
|
1899 |
# ************************************************************
|
|
|
1900 |
|
|
|
1901 |
sub supports_make_coexistence {
|
|
|
1902 |
#my($self) = shift;
|
|
|
1903 |
return 0;
|
|
|
1904 |
}
|
|
|
1905 |
|
|
|
1906 |
|
|
|
1907 |
sub generate_implicit_project_dependencies {
|
|
|
1908 |
#my($self) = shift;
|
|
|
1909 |
return 0;
|
|
|
1910 |
}
|
|
|
1911 |
|
|
|
1912 |
|
|
|
1913 |
sub workspace_file_name {
|
|
|
1914 |
#my($self) = shift;
|
|
|
1915 |
return '';
|
|
|
1916 |
}
|
|
|
1917 |
|
|
|
1918 |
|
|
|
1919 |
sub workspace_per_project {
|
|
|
1920 |
#my($self) = shift;
|
|
|
1921 |
return 0;
|
|
|
1922 |
}
|
|
|
1923 |
|
|
|
1924 |
|
|
|
1925 |
sub pre_workspace {
|
|
|
1926 |
#my($self) = shift;
|
|
|
1927 |
#my($fh) = shift;
|
|
|
1928 |
}
|
|
|
1929 |
|
|
|
1930 |
|
|
|
1931 |
sub write_comps {
|
|
|
1932 |
#my($self) = shift;
|
|
|
1933 |
#my($fh) = shift;
|
|
|
1934 |
#my($gens) = shift;
|
|
|
1935 |
#my($top) = shift;
|
|
|
1936 |
}
|
|
|
1937 |
|
|
|
1938 |
|
|
|
1939 |
sub post_workspace {
|
|
|
1940 |
#my($self) = shift;
|
|
|
1941 |
#my($fh) = shift;
|
|
|
1942 |
}
|
|
|
1943 |
|
|
|
1944 |
|
|
|
1945 |
1;
|