]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/prj-proc.adb
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
trans-array.c (gfc_conv_descriptor_data_get): Rename from gfc_conv_descriptor_data.
[thirdparty/gcc.git] / gcc / ada / prj-proc.adb
CommitLineData
19235870
RK		 1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- P R J . P R O C --
6-- --
7-- B o d y --
8-- --
7e98a4c6 9-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
19235870
RK		 10-- --
11-- GNAT is free software; you can redistribute it and/or modify it under --
12-- terms of the GNU General Public License as published by the Free Soft- --
13-- ware Foundation; either version 2, or (at your option) any later ver- --
14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17-- for more details. You should have received a copy of the GNU General --
18-- Public License distributed with GNAT; see file COPYING. If not, write --
19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20-- MA 02111-1307, USA. --
21-- --
22-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 23-- Extensive contributions were provided by Ada Core Technologies Inc. --
19235870
RK		 24-- --
25------------------------------------------------------------------------------
26
fbf5a39b 27with Err_Vars; use Err_Vars;
19235870
RK		 28with Namet; use Namet;
29with Opt;
fbf5a39b 30with Osint; use Osint;
19235870
RK		 31with Output; use Output;
32with Prj.Attr; use Prj.Attr;
fbf5a39b 33with Prj.Err; use Prj.Err;
19235870
RK		 34with Prj.Ext; use Prj.Ext;
35with Prj.Nmsc; use Prj.Nmsc;
c8b0c260 36with Sinput; use Sinput;
b5e792e2 37with Snames;
19235870 38
07fc65c4 39with GNAT.Case_Util; use GNAT.Case_Util;
19235870
RK		 40with GNAT.HTable;
41
42package body Prj.Proc is
43
44 Error_Report : Put_Line_Access := null;
45
46 package Processed_Projects is new GNAT.HTable.Simple_HTable
47 (Header_Num => Header_Num,
48 Element => Project_Id,
49 No_Element => No_Project,
50 Key => Name_Id,
51 Hash => Hash,
52 Equal => "=");
53 -- This hash table contains all processed projects
54
fbf5a39b 55 procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
19235870
RK		 56 -- Concatenate two strings and returns another string if both
57 -- arguments are not null string.
58
59 procedure Add_Attributes
d05ef0ab 60 (Project : Project_Id;
7e98a4c6 61 In_Tree : Project_Tree_Ref;
d05ef0ab
AC		 62 Decl : in out Declarations;
63 First : Attribute_Node_Id);
19235870
RK		 64 -- Add all attributes, starting with First, with their default
65 -- values to the package or project with declarations Decl.
66
0da2c8ac 67 procedure Check
7e98a4c6
VC		 68 (In_Tree : Project_Tree_Ref;
69 Project : in out Project_Id;
44e1918a 70 Follow_Links : Boolean);
0da2c8ac
AC		 71 -- Set all projects to not checked, then call Recursive_Check for the
72 -- main project Project. Project is set to No_Project if errors occurred.
0da2c8ac 73
19235870 74 function Expression
7e98a4c6
VC		 75 (Project : Project_Id;
76 In_Tree : Project_Tree_Ref;
77 From_Project_Node : Project_Node_Id;
78 From_Project_Node_Tree : Project_Node_Tree_Ref;
79 Pkg : Package_Id;
80 First_Term : Project_Node_Id;
81 Kind : Variable_Kind) return Variable_Value;
19235870
RK		 82 -- From N_Expression project node From_Project_Node, compute the value
83 -- of an expression and return it as a Variable_Value.
84
fbf5a39b 85 function Imported_Or_Extended_Project_From
19235870 86 (Project : Project_Id;
7e98a4c6 87 In_Tree : Project_Tree_Ref;
d05ef0ab 88 With_Name : Name_Id) return Project_Id;
fbf5a39b 89 -- Find an imported or extended project of Project whose name is With_Name
19235870
RK		 90
91 function Package_From
92 (Project : Project_Id;
7e98a4c6 93 In_Tree : Project_Tree_Ref;
d05ef0ab 94 With_Name : Name_Id) return Package_Id;
07fc65c4 95 -- Find the package of Project whose name is With_Name
19235870
RK		 96
97 procedure Process_Declarative_Items
7e98a4c6
VC		 98 (Project : Project_Id;
99 In_Tree : Project_Tree_Ref;
100 From_Project_Node : Project_Node_Id;
101 From_Project_Node_Tree : Project_Node_Tree_Ref;
102 Pkg : Package_Id;
103 Item : Project_Node_Id);
19235870
RK		 104 -- Process declarative items starting with From_Project_Node, and put them
105 -- in declarations Decl. This is a recursive procedure; it calls itself for
106 -- a package declaration or a case construction.
107
108 procedure Recursive_Process
7e98a4c6
VC		 109 (In_Tree : Project_Tree_Ref;
110 Project : out Project_Id;
111 From_Project_Node : Project_Node_Id;
112 From_Project_Node_Tree : Project_Node_Tree_Ref;
113 Extended_By : Project_Id);
19235870
RK		 114 -- Process project with node From_Project_Node in the tree.
115 -- Do nothing if From_Project_Node is Empty_Node.
116 -- If project has already been processed, simply return its project id.
117 -- Otherwise create a new project id, mark it as processed, call itself
fbf5a39b 118 -- recursively for all imported projects and a extended project, if any.
19235870
RK		 119 -- Then process the declarative items of the project.
120
7324bf49 121 procedure Recursive_Check
44e1918a 122 (Project : Project_Id;
7e98a4c6 123 In_Tree : Project_Tree_Ref;
44e1918a 124 Follow_Links : Boolean);
fbf5a39b 125 -- If Project is not marked as checked, mark it as checked, call
07fc65c4 126 -- Check_Naming_Scheme for the project, then call itself for a
fbf5a39b 127 -- possible extended project and all the imported projects of Project.
19235870
RK		 128
129 ---------
130 -- Add --
131 ---------
132
fbf5a39b 133 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
19235870 134 begin
fbf5a39b 135 if To_Exp = Types.No_Name or else To_Exp = Empty_String then
19235870 136
44e1918a 137 -- To_Exp is nil or empty. The result is Str
19235870
RK		 138
139 To_Exp := Str;
140
141 -- If Str is nil, then do not change To_Ext
142
fbf5a39b
AC		 143 elsif Str /= No_Name and then Str /= Empty_String then
144 declare
145 S : constant String := Get_Name_String (Str);
146
147 begin
148 Get_Name_String (To_Exp);
149 Add_Str_To_Name_Buffer (S);
150 To_Exp := Name_Find;
151 end;
19235870
RK		 152 end if;
153 end Add;
154
155 --------------------
156 -- Add_Attributes --
157 --------------------
158
159 procedure Add_Attributes
d05ef0ab 160 (Project : Project_Id;
7e98a4c6 161 In_Tree : Project_Tree_Ref;
d05ef0ab
AC		 162 Decl : in out Declarations;
163 First : Attribute_Node_Id)
fbf5a39b 164 is
19235870 165 The_Attribute : Attribute_Node_Id := First;
19235870
RK		 166
167 begin
168 while The_Attribute /= Empty_Attribute loop
523456db 169 if Attribute_Kind_Of (The_Attribute) = Single then
19235870
RK		 170 declare
171 New_Attribute : Variable_Value;
172
173 begin
523456db 174 case Variable_Kind_Of (The_Attribute) is
19235870
RK		 175
176 -- Undefined should not happen
177
178 when Undefined =>
179 pragma Assert
180 (False, "attribute with an undefined kind");
181 raise Program_Error;
182
183 -- Single attributes have a default value of empty string
184
185 when Single =>
186 New_Attribute :=
d05ef0ab
AC		 187 (Project => Project,
188 Kind => Single,
19235870
RK		 189 Location => No_Location,
190 Default => True,
aa720a54
AC		 191 Value => Empty_String,
192 Index => 0);
19235870
RK		 193
194 -- List attributes have a default value of nil list
195
196 when List =>
197 New_Attribute :=
d05ef0ab
AC		 198 (Project => Project,
199 Kind => List,
19235870
RK		 200 Location => No_Location,
201 Default => True,
202 Values => Nil_String);
203
204 end case;
205
7e98a4c6
VC		 206 Variable_Element_Table.Increment_Last
207 (In_Tree.Variable_Elements);
208 In_Tree.Variable_Elements.Table
209 (Variable_Element_Table.Last
210 (In_Tree.Variable_Elements)) :=
19235870 211 (Next => Decl.Attributes,
523456db 212 Name => Attribute_Name_Of (The_Attribute),
19235870 213 Value => New_Attribute);
7e98a4c6
VC		 214 Decl.Attributes := Variable_Element_Table.Last
215 (In_Tree.Variable_Elements);
19235870
RK		 216 end;
217 end if;
218
523456db 219 The_Attribute := Next_Attribute (After => The_Attribute);
19235870 220 end loop;
19235870
RK		 221 end Add_Attributes;
222
223 -----------
224 -- Check --
225 -----------
226
7324bf49 227 procedure Check
7e98a4c6
VC		 228 (In_Tree : Project_Tree_Ref;
229 Project : in out Project_Id;
44e1918a
AC		 230 Follow_Links : Boolean)
231 is
19235870 232 begin
07fc65c4 233 -- Make sure that all projects are marked as not checked
19235870 234
7e98a4c6
VC		 235 for Index in Project_Table.First ..
236 Project_Table.Last (In_Tree.Projects)
237 loop
238 In_Tree.Projects.Table (Index).Checked := False;
19235870
RK		 239 end loop;
240
7e98a4c6 241 Recursive_Check (Project, In_Tree, Follow_Links);
19235870
RK		 242 end Check;
243
244 ----------------
245 -- Expression --
246 ----------------
247
248 function Expression
7e98a4c6
VC		 249 (Project : Project_Id;
250 In_Tree : Project_Tree_Ref;
251 From_Project_Node : Project_Node_Id;
252 From_Project_Node_Tree : Project_Node_Tree_Ref;
253 Pkg : Package_Id;
254 First_Term : Project_Node_Id;
255 Kind : Variable_Kind) return Variable_Value
19235870
RK		 256 is
257 The_Term : Project_Node_Id := First_Term;
258 -- The term in the expression list
259
260 The_Current_Term : Project_Node_Id := Empty_Node;
261 -- The current term node id
262
19235870
RK		 263 Result : Variable_Value (Kind => Kind);
264 -- The returned result
265
266 Last : String_List_Id := Nil_String;
44e1918a 267 -- Reference to the last string elements in Result, when Kind is List
19235870
RK		 268
269 begin
d05ef0ab 270 Result.Project := Project;
7e98a4c6 271 Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
19235870
RK		 272
273 -- Process each term of the expression, starting with First_Term
274
275 while The_Term /= Empty_Node loop
7e98a4c6 276 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
19235870 277
7e98a4c6 278 case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
19235870
RK		 279
280 when N_Literal_String =>
281
282 case Kind is
283
284 when Undefined =>
285
286 -- Should never happen
287
288 pragma Assert (False, "Undefined expression kind");
289 raise Program_Error;
290
291 when Single =>
7e98a4c6
VC		 292 Add (Result.Value,
293 String_Value_Of
294 (The_Current_Term, From_Project_Node_Tree));
295 Result.Index :=
296 Source_Index_Of
297 (The_Current_Term, From_Project_Node_Tree);
19235870
RK		 298
299 when List =>
300
7e98a4c6
VC		 301 String_Element_Table.Increment_Last
302 (In_Tree.String_Elements);
19235870
RK		 303
304 if Last = Nil_String then
305
44e1918a 306 -- This can happen in an expression like () & "toto"
19235870 307
7e98a4c6
VC		 308 Result.Values := String_Element_Table.Last
309 (In_Tree.String_Elements);
19235870
RK		 310
311 else
7e98a4c6
VC		 312 In_Tree.String_Elements.Table
313 (Last).Next := String_Element_Table.Last
314 (In_Tree.String_Elements);
19235870
RK		 315 end if;
316
7e98a4c6
VC		 317 Last := String_Element_Table.Last
318 (In_Tree.String_Elements);
319 In_Tree.String_Elements.Table (Last) :=
320 (Value =>
321 String_Value_Of
322 (The_Current_Term,
323 From_Project_Node_Tree),
324 Index =>
325 Source_Index_Of
326 (The_Current_Term, From_Project_Node_Tree),
fbf5a39b 327 Display_Value => No_Name,
7e98a4c6
VC		 328 Location =>
329 Location_Of
330 (The_Current_Term,
331 From_Project_Node_Tree),
fbf5a39b 332 Flag => False,
19235870 333 Next => Nil_String);
19235870
RK		 334 end case;
335
336 when N_Literal_String_List =>
337
338 declare
339 String_Node : Project_Node_Id :=
7e98a4c6
VC		 340 First_Expression_In_List
341 (The_Current_Term,
342 From_Project_Node_Tree);
19235870
RK		 343
344 Value : Variable_Value;
345
346 begin
347 if String_Node /= Empty_Node then
348
349 -- If String_Node is nil, it is an empty list,
350 -- there is nothing to do
351
352 Value := Expression
7e98a4c6
VC		 353 (Project => Project,
354 In_Tree => In_Tree,
355 From_Project_Node => From_Project_Node,
356 From_Project_Node_Tree => From_Project_Node_Tree,
357 Pkg => Pkg,
358 First_Term =>
359 Tree.First_Term
360 (String_Node, From_Project_Node_Tree),
361 Kind => Single);
362 String_Element_Table.Increment_Last
363 (In_Tree.String_Elements);
19235870
RK		 364
365 if Result.Values = Nil_String then
366
367 -- This literal string list is the first term
368 -- in a string list expression
369
7e98a4c6
VC		 370 Result.Values :=
371 String_Element_Table.Last (In_Tree.String_Elements);
19235870
RK		 372
373 else
7e98a4c6
VC		 374 In_Tree.String_Elements.Table
375 (Last).Next :=
376 String_Element_Table.Last (In_Tree.String_Elements);
19235870
RK		 377 end if;
378
7e98a4c6
VC		 379 Last :=
380 String_Element_Table.Last (In_Tree.String_Elements);
381
382 In_Tree.String_Elements.Table (Last) :=
19235870 383 (Value => Value.Value,
fbf5a39b 384 Display_Value => No_Name,
19235870 385 Location => Value.Location,
fbf5a39b 386 Flag => False,
aa720a54
AC		 387 Next => Nil_String,
388 Index => Value.Index);
19235870
RK		 389
390 loop
391 -- Add the other element of the literal string list
392 -- one after the other
393
394 String_Node :=
7e98a4c6
VC		 395 Next_Expression_In_List
396 (String_Node, From_Project_Node_Tree);
19235870
RK		 397
398 exit when String_Node = Empty_Node;
399
400 Value :=
401 Expression
7e98a4c6
VC		 402 (Project => Project,
403 In_Tree => In_Tree,
404 From_Project_Node => From_Project_Node,
405 From_Project_Node_Tree => From_Project_Node_Tree,
406 Pkg => Pkg,
407 First_Term =>
408 Tree.First_Term
409 (String_Node, From_Project_Node_Tree),
410 Kind => Single);
411
412 String_Element_Table.Increment_Last
413 (In_Tree.String_Elements);
414 In_Tree.String_Elements.Table
415 (Last).Next := String_Element_Table.Last
416 (In_Tree.String_Elements);
417 Last := String_Element_Table.Last
418 (In_Tree.String_Elements);
419 In_Tree.String_Elements.Table (Last) :=
19235870 420 (Value => Value.Value,
fbf5a39b 421 Display_Value => No_Name,
19235870 422 Location => Value.Location,
fbf5a39b 423 Flag => False,
aa720a54
AC		 424 Next => Nil_String,
425 Index => Value.Index);
19235870 426 end loop;
19235870 427 end if;
19235870
RK		 428 end;
429
430 when N_Variable_Reference | N_Attribute_Reference =>
431
432 declare
433 The_Project : Project_Id := Project;
434 The_Package : Package_Id := Pkg;
435 The_Name : Name_Id := No_Name;
436 The_Variable_Id : Variable_Id := No_Variable;
07fc65c4 437 The_Variable : Variable_Value;
19235870 438 Term_Project : constant Project_Node_Id :=
7e98a4c6
VC		 439 Project_Node_Of
440 (The_Current_Term, From_Project_Node_Tree);
19235870 441 Term_Package : constant Project_Node_Id :=
7e98a4c6
VC		 442 Package_Node_Of
443 (The_Current_Term, From_Project_Node_Tree);
fbf5a39b 444 Index : Name_Id := No_Name;
19235870
RK		 445
446 begin
447 if Term_Project /= Empty_Node and then
448 Term_Project /= From_Project_Node
449 then
450 -- This variable or attribute comes from another project
451
7e98a4c6
VC		 452 The_Name :=
453 Name_Of (Term_Project, From_Project_Node_Tree);
fbf5a39b
AC		 454 The_Project := Imported_Or_Extended_Project_From
455 (Project => Project,
7e98a4c6 456 In_Tree => In_Tree,
fbf5a39b 457 With_Name => The_Name);
19235870
RK		 458 end if;
459
460 if Term_Package /= Empty_Node then
461
462 -- This is an attribute of a package
463
7e98a4c6
VC		 464 The_Name :=
465 Name_Of (Term_Package, From_Project_Node_Tree);
466 The_Package := In_Tree.Projects.Table
467 (The_Project).Decl.Packages;
19235870
RK		 468
469 while The_Package /= No_Package
7e98a4c6
VC		 470 and then In_Tree.Packages.Table
471 (The_Package).Name /= The_Name
19235870 472 loop
7e98a4c6
VC		 473 The_Package :=
474 In_Tree.Packages.Table
475 (The_Package).Next;
19235870
RK		 476 end loop;
477
478 pragma Assert
479 (The_Package /= No_Package,
480 "package not found.");
481
7e98a4c6
VC		 482 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
483 N_Attribute_Reference
484 then
19235870
RK		 485 The_Package := No_Package;
486 end if;
487
7e98a4c6
VC		 488 The_Name :=
489 Name_Of (The_Current_Term, From_Project_Node_Tree);
19235870 490
7e98a4c6
VC		 491 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
492 N_Attribute_Reference
493 then
494 Index :=
495 Associative_Array_Index_Of
496 (The_Current_Term, From_Project_Node_Tree);
07fc65c4 497 end if;
19235870 498
07fc65c4 499 -- If it is not an associative array attribute
19235870 500
fbf5a39b 501 if Index = No_Name then
07fc65c4
GB		 502
503 -- It is not an associative array attribute
504
505 if The_Package /= No_Package then
506
507 -- First, if there is a package, look into the package
508
7e98a4c6
VC		 509 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
510 N_Variable_Reference
07fc65c4
GB		 511 then
512 The_Variable_Id :=
7e98a4c6
VC		 513 In_Tree.Packages.Table
514 (The_Package).Decl.Variables;
07fc65c4
GB		 515 else
516 The_Variable_Id :=
7e98a4c6
VC		 517 In_Tree.Packages.Table
518 (The_Package).Decl.Attributes;
07fc65c4
GB		 519 end if;
520
521 while The_Variable_Id /= No_Variable
522 and then
7e98a4c6
VC		 523 In_Tree.Variable_Elements.Table
524 (The_Variable_Id).Name /= The_Name
07fc65c4
GB		 525 loop
526 The_Variable_Id :=
7e98a4c6
VC		 527 In_Tree.Variable_Elements.Table
528 (The_Variable_Id).Next;
07fc65c4 529 end loop;
19235870 530
19235870
RK		 531 end if;
532
07fc65c4 533 if The_Variable_Id = No_Variable then
19235870 534
07fc65c4 535 -- If we have not found it, look into the project
19235870 536
7e98a4c6
VC		 537 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
538 N_Variable_Reference
07fc65c4
GB		 539 then
540 The_Variable_Id :=
7e98a4c6
VC		 541 In_Tree.Projects.Table
542 (The_Project).Decl.Variables;
07fc65c4
GB		 543 else
544 The_Variable_Id :=
7e98a4c6
VC		 545 In_Tree.Projects.Table
546 (The_Project).Decl.Attributes;
07fc65c4 547 end if;
19235870 548
07fc65c4
GB		 549 while The_Variable_Id /= No_Variable
550 and then
7e98a4c6
VC		 551 In_Tree.Variable_Elements.Table
552 (The_Variable_Id).Name /= The_Name
07fc65c4
GB		 553 loop
554 The_Variable_Id :=
7e98a4c6
VC		 555 In_Tree.Variable_Elements.Table
556 (The_Variable_Id).Next;
07fc65c4 557 end loop;
19235870 558
19235870
RK		 559 end if;
560
07fc65c4
GB		 561 pragma Assert (The_Variable_Id /= No_Variable,
562 "variable or attribute not found");
19235870 563
7e98a4c6
VC		 564 The_Variable :=
565 In_Tree.Variable_Elements.Table
07fc65c4
GB		 566 (The_Variable_Id).Value;
567
568 else
19235870 569
07fc65c4 570 -- It is an associative array attribute
19235870 571
07fc65c4
GB		 572 declare
573 The_Array : Array_Id := No_Array;
574 The_Element : Array_Element_Id := No_Array_Element;
575 Array_Index : Name_Id := No_Name;
7e98a4c6 576
07fc65c4
GB		 577 begin
578 if The_Package /= No_Package then
579 The_Array :=
7e98a4c6
VC		 580 In_Tree.Packages.Table
581 (The_Package).Decl.Arrays;
07fc65c4
GB		 582 else
583 The_Array :=
7e98a4c6
VC		 584 In_Tree.Projects.Table
585 (The_Project).Decl.Arrays;
07fc65c4
GB		 586 end if;
587
588 while The_Array /= No_Array
7e98a4c6
VC		 589 and then In_Tree.Arrays.Table
590 (The_Array).Name /= The_Name
07fc65c4 591 loop
7e98a4c6
VC		 592 The_Array := In_Tree.Arrays.Table
593 (The_Array).Next;
07fc65c4
GB		 594 end loop;
595
596 if The_Array /= No_Array then
7e98a4c6
VC		 597 The_Element := In_Tree.Arrays.Table
598 (The_Array).Value;
07fc65c4 599
fbf5a39b 600 Get_Name_String (Index);
07fc65c4 601
7e98a4c6
VC		 602 if Case_Insensitive
603 (The_Current_Term, From_Project_Node_Tree)
604 then
07fc65c4
GB		 605 To_Lower (Name_Buffer (1 .. Name_Len));
606 end if;
607
608 Array_Index := Name_Find;
609
610 while The_Element /= No_Array_Element
7e98a4c6
VC		 611 and then
612 In_Tree.Array_Elements.Table
613 (The_Element).Index /= Array_Index
07fc65c4
GB		 614 loop
615 The_Element :=
7e98a4c6
VC		 616 In_Tree.Array_Elements.Table
617 (The_Element).Next;
07fc65c4
GB		 618 end loop;
619
620 end if;
621
622 if The_Element /= No_Array_Element then
623 The_Variable :=
7e98a4c6
VC		 624 In_Tree.Array_Elements.Table
625 (The_Element).Value;
07fc65c4
GB		 626
627 else
7e98a4c6
VC		 628 if Expression_Kind_Of
629 (The_Current_Term, From_Project_Node_Tree) =
630 List
07fc65c4
GB		 631 then
632 The_Variable :=
d05ef0ab
AC		 633 (Project => Project,
634 Kind => List,
07fc65c4
GB		 635 Location => No_Location,
636 Default => True,
637 Values => Nil_String);
07fc65c4
GB		 638 else
639 The_Variable :=
d05ef0ab
AC		 640 (Project => Project,
641 Kind => Single,
07fc65c4
GB		 642 Location => No_Location,
643 Default => True,
aa720a54
AC		 644 Value => Empty_String,
645 Index => 0);
07fc65c4 646 end if;
07fc65c4 647 end if;
07fc65c4 648 end;
07fc65c4 649 end if;
19235870
RK		 650
651 case Kind is
652
653 when Undefined =>
654
655 -- Should never happen
656
657 pragma Assert (False, "undefined expression kind");
658 null;
659
660 when Single =>
661
07fc65c4 662 case The_Variable.Kind is
19235870
RK		 663
664 when Undefined =>
665 null;
666
667 when Single =>
07fc65c4 668 Add (Result.Value, The_Variable.Value);
19235870
RK		 669
670 when List =>
671
672 -- Should never happen
673
674 pragma Assert
675 (False,
676 "list cannot appear in single " &
677 "string expression");
678 null;
19235870
RK		 679 end case;
680
681 when List =>
07fc65c4 682 case The_Variable.Kind is
19235870
RK		 683
684 when Undefined =>
685 null;
686
687 when Single =>
7e98a4c6
VC		 688 String_Element_Table.Increment_Last
689 (In_Tree.String_Elements);
19235870
RK		 690
691 if Last = Nil_String then
692
693 -- This can happen in an expression such as
694 -- () & Var
695
7e98a4c6
VC		 696 Result.Values :=
697 String_Element_Table.Last
698 (In_Tree.String_Elements);
19235870
RK		 699
700 else
7e98a4c6
VC		 701 In_Tree.String_Elements.Table
702 (Last).Next :=
703 String_Element_Table.Last
704 (In_Tree.String_Elements);
19235870
RK		 705 end if;
706
7e98a4c6
VC		 707 Last :=
708 String_Element_Table.Last
709 (In_Tree.String_Elements);
710
711 In_Tree.String_Elements.Table (Last) :=
712 (Value => The_Variable.Value,
fbf5a39b 713 Display_Value => No_Name,
7e98a4c6
VC		 714 Location => Location_Of
715 (The_Current_Term,
716 From_Project_Node_Tree),
717 Flag => False,
718 Next => Nil_String,
719 Index => 0);
19235870
RK		 720
721 when List =>
722
723 declare
724 The_List : String_List_Id :=
07fc65c4 725 The_Variable.Values;
19235870
RK		 726
727 begin
728 while The_List /= Nil_String loop
7e98a4c6
VC		 729 String_Element_Table.Increment_Last
730 (In_Tree.String_Elements);
19235870
RK		 731
732 if Last = Nil_String then
7e98a4c6
VC		 733 Result.Values :=
734 String_Element_Table.Last
735 (In_Tree.
736 String_Elements);
19235870
RK		 737
738 else
7e98a4c6
VC		 739 In_Tree.
740 String_Elements.Table (Last).Next :=
741 String_Element_Table.Last
742 (In_Tree.
743 String_Elements);
19235870
RK		 744
745 end if;
746
7e98a4c6
VC		 747 Last :=
748 String_Element_Table.Last
749 (In_Tree.String_Elements);
750
751 In_Tree.String_Elements.Table (Last) :=
752 (Value =>
753 In_Tree.String_Elements.Table
754 (The_List).Value,
fbf5a39b 755 Display_Value => No_Name,
7e98a4c6
VC		 756 Location =>
757 Location_Of
758 (The_Current_Term,
759 From_Project_Node_Tree),
760 Flag => False,
761 Next => Nil_String,
762 Index => 0);
763
19235870 764 The_List :=
7e98a4c6
VC		 765 In_Tree. String_Elements.Table
766 (The_List).Next;
19235870
RK		 767 end loop;
768 end;
769 end case;
770 end case;
771 end;
772
773 when N_External_Value =>
fbf5a39b 774 Get_Name_String
7e98a4c6
VC		 775 (String_Value_Of
776 (External_Reference_Of
777 (The_Current_Term, From_Project_Node_Tree),
778 From_Project_Node_Tree));
19235870
RK		 779
780 declare
781 Name : constant Name_Id := Name_Find;
fbf5a39b
AC		 782 Default : Name_Id := No_Name;
783 Value : Name_Id := No_Name;
19235870 784
c8b0c260
VC		 785 Def_Var : Variable_Value;
786
19235870 787 Default_Node : constant Project_Node_Id :=
7e98a4c6
VC		 788 External_Default_Of
789 (The_Current_Term, From_Project_Node_Tree);
19235870
RK		 790
791 begin
c8b0c260
VC		 792 -- If there is a default value for the external reference,
793 -- get its value.
794
19235870 795 if Default_Node /= Empty_Node then
c8b0c260
VC		 796 Def_Var := Expression
797 (Project => Project,
798 In_Tree => In_Tree,
799 From_Project_Node => Default_Node,
800 From_Project_Node_Tree => From_Project_Node_Tree,
801 Pkg => Pkg,
802 First_Term =>
803 Tree.First_Term
804 (Default_Node, From_Project_Node_Tree),
805 Kind => Single);
806
807 if Def_Var /= Nil_Variable_Value then
808 Default := Def_Var.Value;
809 end if;
19235870
RK		 810 end if;
811
812 Value := Prj.Ext.Value_Of (Name, Default);
813
fbf5a39b
AC		 814 if Value = No_Name then
815 if not Opt.Quiet_Output then
816 if Error_Report = null then
817 Error_Msg
818 ("?undefined external reference",
7e98a4c6
VC		 819 Location_Of
820 (The_Current_Term, From_Project_Node_Tree));
fbf5a39b
AC		 821 else
822 Error_Report
823 ("warning: """ & Get_Name_String (Name) &
824 """ is an undefined external reference",
7e98a4c6 825 Project, In_Tree);
fbf5a39b 826 end if;
19235870
RK		 827 end if;
828
829 Value := Empty_String;
19235870
RK		 830 end if;
831
832 case Kind is
833
834 when Undefined =>
835 null;
836
837 when Single =>
838 Add (Result.Value, Value);
839
840 when List =>
7e98a4c6
VC		 841 String_Element_Table.Increment_Last
842 (In_Tree.String_Elements);
19235870
RK		 843
844 if Last = Nil_String then
7e98a4c6
VC		 845 Result.Values := String_Element_Table.Last
846 (In_Tree.String_Elements);
19235870
RK		 847
848 else
7e98a4c6
VC		 849 In_Tree.String_Elements.Table
850 (Last).Next := String_Element_Table.Last
851 (In_Tree.String_Elements);
19235870
RK		 852 end if;
853
7e98a4c6
VC		 854 Last := String_Element_Table.Last
855 (In_Tree.String_Elements);
856 In_Tree.String_Elements.Table (Last) :=
19235870 857 (Value => Value,
fbf5a39b 858 Display_Value => No_Name,
7e98a4c6
VC		 859 Location =>
860 Location_Of
861 (The_Current_Term, From_Project_Node_Tree),
fbf5a39b 862 Flag => False,
aa720a54
AC		 863 Next => Nil_String,
864 Index => 0);
19235870
RK		 865
866 end case;
19235870
RK		 867 end;
868
869 when others =>
870
871 -- Should never happen
872
873 pragma Assert
874 (False,
875 "illegal node kind in an expression");
876 raise Program_Error;
877
878 end case;
879
7e98a4c6 880 The_Term := Next_Term (The_Term, From_Project_Node_Tree);
19235870 881 end loop;
767b404e 882
19235870
RK		 883 return Result;
884 end Expression;
885
886 ---------------------------------------
fbf5a39b 887 -- Imported_Or_Extended_Project_From --
19235870
RK		 888 ---------------------------------------
889
fbf5a39b 890 function Imported_Or_Extended_Project_From
19235870 891 (Project : Project_Id;
7e98a4c6 892 In_Tree : Project_Tree_Ref;
d05ef0ab 893 With_Name : Name_Id) return Project_Id
19235870 894 is
7e98a4c6
VC		 895 Data : constant Project_Data :=
896 In_Tree.Projects.Table (Project);
1ae44ba2
VC		 897 List : Project_List := Data.Imported_Projects;
898 Result : Project_Id := No_Project;
899 Temp_Result : Project_Id := No_Project;
19235870
RK		 900
901 begin
1ae44ba2 902 -- First check if it is the name of an extended project
19235870 903
fbf5a39b 904 if Data.Extends /= No_Project
7e98a4c6
VC		 905 and then In_Tree.Projects.Table (Data.Extends).Name =
906 With_Name
19235870 907 then
fbf5a39b 908 return Data.Extends;
19235870
RK		 909
910 else
911 -- Then check the name of each imported project
912
1ae44ba2 913 while List /= Empty_Project_List loop
7e98a4c6 914 Result := In_Tree.Project_Lists.Table (List).Project;
1ae44ba2
VC		 915
916 -- If the project is directly imported, then returns its ID
917
7e98a4c6
VC		 918 if
919 In_Tree.Projects.Table (Result).Name = With_Name
920 then
1ae44ba2
VC		 921 return Result;
922 end if;
923
924 -- If a project extending the project is imported, then keep
925 -- this extending project as a possibility. It will be the
926 -- returned ID if the project is not imported directly.
927
928 declare
7e98a4c6
VC		 929 Proj : Project_Id :=
930 In_Tree.Projects.Table (Result).Extends;
1ae44ba2
VC		 931 begin
932 while Proj /= No_Project loop
7e98a4c6
VC		 933 if In_Tree.Projects.Table (Proj).Name =
934 With_Name
935 then
1ae44ba2
VC		 936 Temp_Result := Result;
937 exit;
938 end if;
939
7e98a4c6 940 Proj := In_Tree.Projects.Table (Proj).Extends;
1ae44ba2
VC		 941 end loop;
942 end;
19235870 943
7e98a4c6 944 List := In_Tree.Project_Lists.Table (List).Next;
19235870
RK		 945 end loop;
946
947 pragma Assert
1ae44ba2 948 (Temp_Result /= No_Project,
19235870
RK		 949 "project not found");
950
1ae44ba2 951 return Temp_Result;
19235870 952 end if;
fbf5a39b 953 end Imported_Or_Extended_Project_From;
19235870
RK		 954
955 ------------------
956 -- Package_From --
957 ------------------
958
959 function Package_From
960 (Project : Project_Id;
7e98a4c6 961 In_Tree : Project_Tree_Ref;
d05ef0ab 962 With_Name : Name_Id) return Package_Id
19235870 963 is
7e98a4c6
VC		 964 Data : constant Project_Data :=
965 In_Tree.Projects.Table (Project);
19235870
RK		 966 Result : Package_Id := Data.Decl.Packages;
967
968 begin
969 -- Check the name of each existing package of Project
970
971 while Result /= No_Package
7e98a4c6 972 and then In_Tree.Packages.Table (Result).Name /= With_Name
19235870 973 loop
7e98a4c6 974 Result := In_Tree.Packages.Table (Result).Next;
19235870
RK		 975 end loop;
976
977 if Result = No_Package then
7e98a4c6 978
19235870 979 -- Should never happen
7e98a4c6 980
19235870
RK		 981 Write_Line ("package """ & Get_Name_String (With_Name) &
982 """ not found");
983 raise Program_Error;
984
985 else
986 return Result;
987 end if;
988 end Package_From;
989
990 -------------
991 -- Process --
992 -------------
993
994 procedure Process
7e98a4c6
VC		 995 (In_Tree : Project_Tree_Ref;
996 Project : out Project_Id;
997 Success : out Boolean;
998 From_Project_Node : Project_Node_Id;
999 From_Project_Node_Tree : Project_Node_Tree_Ref;
1000 Report_Error : Put_Line_Access;
1001 Follow_Links : Boolean := True)
19235870 1002 is
b7e429ab
AC		 1003 Obj_Dir : Name_Id;
1004 Extending : Project_Id;
1005 Extending2 : Project_Id;
fbf5a39b 1006
19235870
RK		 1007 begin
1008 Error_Report := Report_Error;
fbf5a39b 1009 Success := True;
19235870
RK		 1010
1011 -- Make sure there is no projects in the data structure
1012
7e98a4c6 1013 Project_Table.Set_Last (In_Tree.Projects, No_Project);
19235870
RK		 1014 Processed_Projects.Reset;
1015
1016 -- And process the main project and all of the projects it depends on,
1017 -- recursively
1018
1019 Recursive_Process
7e98a4c6
VC		 1020 (Project => Project,
1021 In_Tree => In_Tree,
1022 From_Project_Node => From_Project_Node,
1023 From_Project_Node_Tree => From_Project_Node_Tree,
1024 Extended_By => No_Project);
19235870 1025
fbf5a39b 1026 if Project /= No_Project then
7e98a4c6 1027 Check (In_Tree, Project, Follow_Links);
19235870
RK		 1028 end if;
1029
9596236a
AC		 1030 -- If main project is an extending all project, set the object
1031 -- directory of all virtual extending projects to the object directory
1032 -- of the main project.
1033
1034 if Project /= No_Project
7e98a4c6 1035 and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
9596236a
AC		 1036 then
1037 declare
1038 Object_Dir : constant Name_Id :=
7e98a4c6 1039 In_Tree.Projects.Table (Project).Object_Directory;
9596236a 1040 begin
7e98a4c6
VC		 1041 for Index in
1042 Project_Table.First .. Project_Table.Last (In_Tree.Projects)
1043 loop
1044 if In_Tree.Projects.Table (Index).Virtual then
1045 In_Tree.Projects.Table (Index).Object_Directory :=
1046 Object_Dir;
9596236a
AC		 1047 end if;
1048 end loop;
1049 end;
1050 end if;
1051
a336eaca
AC		 1052 -- Check that no extending project shares its object directory with
1053 -- the project(s) it extends.
fbf5a39b 1054
19235870 1055 if Project /= No_Project then
7e98a4c6
VC		 1056 for Proj in
1057 Project_Table.First .. Project_Table.Last (In_Tree.Projects)
1058 loop
1059 Extending := In_Tree.Projects.Table (Proj).Extended_By;
fbf5a39b
AC		 1060
1061 if Extending /= No_Project then
7e98a4c6 1062 Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
fbf5a39b 1063
b7e429ab
AC		 1064 -- Check that a project being extended does not share its
1065 -- object directory with any project that extends it, directly
1066 -- or indirectly, including a virtual extending project.
1067
1068 -- Start with the project directly extending it
1069
1070 Extending2 := Extending;
b7e429ab 1071 while Extending2 /= No_Project loop
7e98a4c6 1072 if In_Tree.Projects.Table (Extending2).Ada_Sources_Present
b7e429ab 1073 and then
7e98a4c6
VC		 1074 In_Tree.Projects.Table (Extending2).Object_Directory =
1075 Obj_Dir
fbf5a39b 1076 then
7e98a4c6 1077 if In_Tree.Projects.Table (Extending2).Virtual then
c8b0c260
VC		 1078 Error_Msg_Name_1 :=
1079 In_Tree.Projects.Table (Proj).Display_Name;
fbf5a39b 1080
9596236a
AC		 1081 if Error_Report = null then
1082 Error_Msg
c8b0c260 1083 ("project { cannot be extended by a virtual " &
b7e429ab 1084 "project with the same object directory",
7e98a4c6 1085 In_Tree.Projects.Table (Proj).Location);
9596236a
AC		 1086 else
1087 Error_Report
1088 ("project """ &
1089 Get_Name_String (Error_Msg_Name_1) &
b7e429ab
AC		 1090 """ cannot be extended by a virtual " &
1091 "project with the same object directory",
7e98a4c6 1092 Project, In_Tree);
9596236a 1093 end if;
fbf5a39b
AC		 1094
1095 else
b7e429ab 1096 Error_Msg_Name_1 :=
c8b0c260 1097 In_Tree.Projects.Table (Extending2).Display_Name;
7e98a4c6 1098 Error_Msg_Name_2 :=
c8b0c260 1099 In_Tree.Projects.Table (Proj).Display_Name;
9596236a
AC		 1100
1101 if Error_Report = null then
b7e429ab 1102 Error_Msg
c8b0c260 1103 ("project { cannot extend project {",
7e98a4c6 1104 In_Tree.Projects.Table (Extending2).Location);
b7e429ab
AC		 1105 Error_Msg
1106 ("\they share the same object directory",
7e98a4c6 1107 In_Tree.Projects.Table (Extending2).Location);
9596236a
AC		 1108
1109 else
1110 Error_Report
1111 ("project """ &
1112 Get_Name_String (Error_Msg_Name_1) &
1113 """ cannot extend project """ &
b7e429ab 1114 Get_Name_String (Error_Msg_Name_2) & """",
7e98a4c6 1115 Project, In_Tree);
b7e429ab
AC		 1116 Error_Report
1117 ("they share the same object directory",
7e98a4c6 1118 Project, In_Tree);
9596236a 1119 end if;
fbf5a39b 1120 end if;
b7e429ab
AC		 1121 end if;
1122
1123 -- Continue with the next extending project, if any
1124
7e98a4c6
VC		 1125 Extending2 :=
1126 In_Tree.Projects.Table (Extending2).Extended_By;
b7e429ab 1127 end loop;
fbf5a39b
AC		 1128 end if;
1129 end loop;
19235870 1130 end if;
fbf5a39b
AC		 1131
1132 Success := Total_Errors_Detected <= 0;
19235870
RK		 1133 end Process;
1134
1135 -------------------------------
1136 -- Process_Declarative_Items --
1137 -------------------------------
1138
1139 procedure Process_Declarative_Items
7e98a4c6
VC		 1140 (Project : Project_Id;
1141 In_Tree : Project_Tree_Ref;
1142 From_Project_Node : Project_Node_Id;
1143 From_Project_Node_Tree : Project_Node_Tree_Ref;
1144 Pkg : Package_Id;
1145 Item : Project_Node_Id)
fbf5a39b 1146 is
19235870 1147 Current_Declarative_Item : Project_Node_Id := Item;
fbf5a39b 1148 Current_Item : Project_Node_Id := Empty_Node;
19235870
RK		 1149
1150 begin
1151 -- For each declarative item
1152
1153 while Current_Declarative_Item /= Empty_Node loop
1154
1155 -- Get its data
1156
7e98a4c6
VC		 1157 Current_Item :=
1158 Current_Item_Node
1159 (Current_Declarative_Item, From_Project_Node_Tree);
19235870
RK		 1160
1161 -- And set Current_Declarative_Item to the next declarative item
fbf5a39b 1162 -- ready for the next iteration.
19235870 1163
7e98a4c6
VC		 1164 Current_Declarative_Item :=
1165 Next_Declarative_Item
1166 (Current_Declarative_Item, From_Project_Node_Tree);
19235870 1167
7e98a4c6 1168 case Kind_Of (Current_Item, From_Project_Node_Tree) is
19235870
RK		 1169
1170 when N_Package_Declaration =>
fbf5a39b 1171 -- Do not process a package declaration that should be ignored
19235870 1172
7e98a4c6
VC		 1173 if Expression_Kind_Of
1174 (Current_Item, From_Project_Node_Tree) /= Ignored
1175 then
fbf5a39b 1176 -- Create the new package
19235870 1177
7e98a4c6 1178 Package_Table.Increment_Last (In_Tree.Packages);
19235870 1179
fbf5a39b 1180 declare
7e98a4c6
VC		 1181 New_Pkg : constant Package_Id :=
1182 Package_Table.Last (In_Tree.Packages);
fbf5a39b 1183 The_New_Package : Package_Element;
19235870 1184
7e98a4c6
VC		 1185 Project_Of_Renamed_Package :
1186 constant Project_Node_Id :=
1187 Project_Of_Renamed_Package_Of
1188 (Current_Item, From_Project_Node_Tree);
19235870 1189
fbf5a39b
AC		 1190 begin
1191 -- Set the name of the new package
19235870 1192
7e98a4c6
VC		 1193 The_New_Package.Name :=
1194 Name_Of (Current_Item, From_Project_Node_Tree);
19235870 1195
fbf5a39b 1196 -- Insert the new package in the appropriate list
19235870 1197
fbf5a39b
AC		 1198 if Pkg /= No_Package then
1199 The_New_Package.Next :=
7e98a4c6
VC		 1200 In_Tree.Packages.Table (Pkg).Decl.Packages;
1201 In_Tree.Packages.Table (Pkg).Decl.Packages :=
1202 New_Pkg;
fbf5a39b
AC		 1203 else
1204 The_New_Package.Next :=
7e98a4c6
VC		 1205 In_Tree.Projects.Table (Project).Decl.Packages;
1206 In_Tree.Projects.Table (Project).Decl.Packages :=
1207 New_Pkg;
fbf5a39b 1208 end if;
19235870 1209
7e98a4c6
VC		 1210 In_Tree.Packages.Table (New_Pkg) :=
1211 The_New_Package;
19235870 1212
fbf5a39b 1213 if Project_Of_Renamed_Package /= Empty_Node then
19235870 1214
fbf5a39b 1215 -- Renamed package
19235870 1216
fbf5a39b
AC		 1217 declare
1218 Project_Name : constant Name_Id :=
7e98a4c6
VC		 1219 Name_Of
1220 (Project_Of_Renamed_Package,
1221 From_Project_Node_Tree);
19235870 1222
7e98a4c6
VC		 1223 Renamed_Project :
1224 constant Project_Id :=
1225 Imported_Or_Extended_Project_From
1226 (Project, In_Tree, Project_Name);
19235870 1227
fbf5a39b 1228 Renamed_Package : constant Package_Id :=
7e98a4c6
VC		 1229 Package_From
1230 (Renamed_Project, In_Tree,
1231 Name_Of
1232 (Current_Item,
1233 From_Project_Node_Tree));
19235870 1234
fbf5a39b
AC		 1235 begin
1236 -- For a renamed package, set declarations to
1237 -- the declarations of the renamed package.
1238
7e98a4c6
VC		 1239 In_Tree.Packages.Table (New_Pkg).Decl :=
1240 In_Tree.Packages.Table (Renamed_Package).Decl;
fbf5a39b
AC		 1241 end;
1242
1243 -- Standard package declaration, not renaming
1244
1245 else
1246 -- Set the default values of the attributes
1247
1248 Add_Attributes
7e98a4c6
VC		 1249 (Project, In_Tree,
1250 In_Tree.Packages.Table (New_Pkg).Decl,
523456db 1251 First_Attribute_Of
7e98a4c6
VC		 1252 (Package_Id_Of
1253 (Current_Item, From_Project_Node_Tree)));
fbf5a39b
AC		 1254
1255 -- And process declarative items of the new package
1256
1257 Process_Declarative_Items
7e98a4c6
VC		 1258 (Project => Project,
1259 In_Tree => In_Tree,
1260 From_Project_Node => From_Project_Node,
1261 From_Project_Node_Tree => From_Project_Node_Tree,
1262 Pkg => New_Pkg,
1263 Item =>
1264 First_Declarative_Item_Of
1265 (Current_Item, From_Project_Node_Tree));
fbf5a39b
AC		 1266 end if;
1267 end;
1268 end if;
19235870
RK		 1269
1270 when N_String_Type_Declaration =>
1271
1272 -- There is nothing to process
1273
1274 null;
1275
1276 when N_Attribute_Declaration |
1277 N_Typed_Variable_Declaration |
1278 N_Variable_Declaration =>
1279
7e98a4c6
VC		 1280 if Expression_Of (Current_Item, From_Project_Node_Tree) =
1281 Empty_Node
1282 then
19235870 1283
fbf5a39b 1284 -- It must be a full associative array attribute declaration
19235870 1285
fbf5a39b
AC		 1286 declare
1287 Current_Item_Name : constant Name_Id :=
7e98a4c6 1288 Name_Of (Current_Item, From_Project_Node_Tree);
fbf5a39b 1289 -- The name of the attribute
19235870 1290
fbf5a39b
AC		 1291 New_Array : Array_Id;
1292 -- The new associative array created
19235870 1293
fbf5a39b
AC		 1294 Orig_Array : Array_Id;
1295 -- The associative array value
19235870 1296
fbf5a39b
AC		 1297 Orig_Project_Name : Name_Id := No_Name;
1298 -- The name of the project where the associative array
1299 -- value is.
19235870 1300
fbf5a39b
AC		 1301 Orig_Project : Project_Id := No_Project;
1302 -- The id of the project where the associative array
1303 -- value is.
19235870 1304
fbf5a39b
AC		 1305 Orig_Package_Name : Name_Id := No_Name;
1306 -- The name of the package, if any, where the associative
1307 -- array value is.
19235870 1308
fbf5a39b
AC		 1309 Orig_Package : Package_Id := No_Package;
1310 -- The id of the package, if any, where the associative
1311 -- array value is.
19235870 1312
fbf5a39b
AC		 1313 New_Element : Array_Element_Id := No_Array_Element;
1314 -- Id of a new array element created
19235870 1315
fbf5a39b
AC		 1316 Prev_Element : Array_Element_Id := No_Array_Element;
1317 -- Last new element id created
1318
1319 Orig_Element : Array_Element_Id := No_Array_Element;
1320 -- Current array element in the original associative
1321 -- array.
1322
1323 Next_Element : Array_Element_Id := No_Array_Element;
1324 -- Id of the array element that follows the new element.
1325 -- This is not always nil, because values for the
1326 -- associative array attribute may already have been
1327 -- declared, and the array elements declared are reused.
1328
1329 begin
1330 -- First, find if the associative array attribute already
1331 -- has elements declared.
1332
1333 if Pkg /= No_Package then
7e98a4c6
VC		 1334 New_Array := In_Tree.Packages.Table
1335 (Pkg).Decl.Arrays;
fbf5a39b
AC		 1336
1337 else
7e98a4c6
VC		 1338 New_Array := In_Tree.Projects.Table
1339 (Project).Decl.Arrays;
19235870 1340 end if;
19235870 1341
7e98a4c6
VC		 1342 while New_Array /= No_Array
1343 and then In_Tree.Arrays.Table (New_Array).Name /=
1344 Current_Item_Name
fbf5a39b 1345 loop
7e98a4c6 1346 New_Array := In_Tree.Arrays.Table (New_Array).Next;
fbf5a39b
AC		 1347 end loop;
1348
1349 -- If the attribute has never been declared add new entry
1350 -- in the arrays of the project/package and link it.
19235870 1351
fbf5a39b 1352 if New_Array = No_Array then
7e98a4c6
VC		 1353 Array_Table.Increment_Last (In_Tree.Arrays);
1354 New_Array := Array_Table.Last (In_Tree.Arrays);
19235870 1355
19235870 1356 if Pkg /= No_Package then
7e98a4c6 1357 In_Tree.Arrays.Table (New_Array) :=
fbf5a39b
AC		 1358 (Name => Current_Item_Name,
1359 Value => No_Array_Element,
7e98a4c6
VC		 1360 Next =>
1361 In_Tree.Packages.Table (Pkg).Decl.Arrays);
1362
1363 In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1364 New_Array;
19235870
RK		 1365
1366 else
7e98a4c6 1367 In_Tree.Arrays.Table (New_Array) :=
fbf5a39b
AC		 1368 (Name => Current_Item_Name,
1369 Value => No_Array_Element,
7e98a4c6
VC		 1370 Next =>
1371 In_Tree.Projects.Table (Project).Decl.Arrays);
1372
1373 In_Tree.Projects.Table (Project).Decl.Arrays :=
1374 New_Array;
19235870 1375 end if;
fbf5a39b 1376 end if;
19235870 1377
fbf5a39b 1378 -- Find the project where the value is declared
19235870 1379
fbf5a39b 1380 Orig_Project_Name :=
7e98a4c6
VC		 1381 Name_Of
1382 (Associative_Project_Of
1383 (Current_Item, From_Project_Node_Tree),
1384 From_Project_Node_Tree);
1385
1386 for Index in Project_Table.First ..
1387 Project_Table.Last
1388 (In_Tree.Projects)
1389 loop
1390 if In_Tree.Projects.Table (Index).Name =
1391 Orig_Project_Name
1392 then
fbf5a39b
AC		 1393 Orig_Project := Index;
1394 exit;
19235870 1395 end if;
fbf5a39b
AC		 1396 end loop;
1397
1398 pragma Assert (Orig_Project /= No_Project,
1399 "original project not found");
1400
7e98a4c6
VC		 1401 if Associative_Package_Of
1402 (Current_Item, From_Project_Node_Tree) = Empty_Node
1403 then
fbf5a39b 1404 Orig_Array :=
7e98a4c6
VC		 1405 In_Tree.Projects.Table
1406 (Orig_Project).Decl.Arrays;
fbf5a39b
AC		 1407
1408 else
1409 -- If in a package, find the package where the
1410 -- value is declared.
1411
1412 Orig_Package_Name :=
7e98a4c6
VC		 1413 Name_Of
1414 (Associative_Package_Of
1415 (Current_Item, From_Project_Node_Tree),
1416 From_Project_Node_Tree);
1417
fbf5a39b 1418 Orig_Package :=
7e98a4c6
VC		 1419 In_Tree.Projects.Table
1420 (Orig_Project).Decl.Packages;
fbf5a39b
AC		 1421 pragma Assert (Orig_Package /= No_Package,
1422 "original package not found");
1423
7e98a4c6
VC		 1424 while In_Tree.Packages.Table
1425 (Orig_Package).Name /= Orig_Package_Name
fbf5a39b 1426 loop
7e98a4c6
VC		 1427 Orig_Package := In_Tree.Packages.Table
1428 (Orig_Package).Next;
fbf5a39b
AC		 1429 pragma Assert (Orig_Package /= No_Package,
1430 "original package not found");
1431 end loop;
19235870 1432
fbf5a39b 1433 Orig_Array :=
7e98a4c6
VC		 1434 In_Tree.Packages.Table
1435 (Orig_Package).Decl.Arrays;
19235870
RK		 1436 end if;
1437
fbf5a39b
AC		 1438 -- Now look for the array
1439
1440 while Orig_Array /= No_Array and then
7e98a4c6
VC		 1441 In_Tree.Arrays.Table (Orig_Array).Name /=
1442 Current_Item_Name
19235870 1443 loop
7e98a4c6
VC		 1444 Orig_Array := In_Tree.Arrays.Table
1445 (Orig_Array).Next;
19235870
RK		 1446 end loop;
1447
fbf5a39b
AC		 1448 if Orig_Array = No_Array then
1449 if Error_Report = null then
1450 Error_Msg
1451 ("associative array value cannot be found",
7e98a4c6
VC		 1452 Location_Of
1453 (Current_Item, From_Project_Node_Tree));
19235870
RK		 1454
1455 else
fbf5a39b
AC		 1456 Error_Report
1457 ("associative array value cannot be found",
7e98a4c6 1458 Project, In_Tree);
19235870
RK		 1459 end if;
1460
1461 else
7e98a4c6
VC		 1462 Orig_Element :=
1463 In_Tree.Arrays.Table (Orig_Array).Value;
19235870 1464
fbf5a39b 1465 -- Copy each array element
19235870 1466
fbf5a39b 1467 while Orig_Element /= No_Array_Element loop
44e1918a
AC		 1468
1469 -- Case of first element
fbf5a39b
AC		 1470
1471 if Prev_Element = No_Array_Element then
44e1918a 1472
fbf5a39b
AC		 1473 -- And there is no array element declared yet,
1474 -- create a new first array element.
19235870 1475
7e98a4c6 1476 if In_Tree.Arrays.Table (New_Array).Value =
fbf5a39b
AC		 1477 No_Array_Element
1478 then
7e98a4c6
VC		 1479 Array_Element_Table.Increment_Last
1480 (In_Tree.Array_Elements);
1481 New_Element := Array_Element_Table.Last
1482 (In_Tree.Array_Elements);
1483 In_Tree.Arrays.Table
1484 (New_Array).Value := New_Element;
fbf5a39b
AC		 1485 Next_Element := No_Array_Element;
1486
1487 -- Otherwise, the new element is the first
1488
1489 else
7e98a4c6
VC		 1490 New_Element := In_Tree.Arrays.
1491 Table (New_Array).Value;
fbf5a39b 1492 Next_Element :=
7e98a4c6
VC		 1493 In_Tree.Array_Elements.Table
1494 (New_Element).Next;
fbf5a39b
AC		 1495 end if;
1496
1497 -- Otherwise, reuse an existing element, or create
1498 -- one if necessary.
1499
1500 else
1501 Next_Element :=
7e98a4c6
VC		 1502 In_Tree.Array_Elements.Table
1503 (Prev_Element).Next;
fbf5a39b
AC		 1504
1505 if Next_Element = No_Array_Element then
7e98a4c6
VC		 1506 Array_Element_Table.Increment_Last
1507 (In_Tree.Array_Elements);
1508 New_Element := Array_Element_Table.Last
1509 (In_Tree.Array_Elements);
fbf5a39b
AC		 1510
1511 else
1512 New_Element := Next_Element;
1513 Next_Element :=
7e98a4c6
VC		 1514 In_Tree.Array_Elements.Table
1515 (New_Element).Next;
fbf5a39b
AC		 1516 end if;
1517 end if;
1518
1519 -- Copy the value of the element
1520
7e98a4c6
VC		 1521 In_Tree.Array_Elements.Table
1522 (New_Element) :=
1523 In_Tree.Array_Elements.Table
1524 (Orig_Element);
1525 In_Tree.Array_Elements.Table
1526 (New_Element).Value.Project := Project;
19235870 1527
fbf5a39b
AC		 1528 -- Adjust the Next link
1529
7e98a4c6
VC		 1530 In_Tree.Array_Elements.Table
1531 (New_Element).Next := Next_Element;
fbf5a39b
AC		 1532
1533 -- Adjust the previous id for the next element
1534
1535 Prev_Element := New_Element;
1536
1537 -- Go to the next element in the original array
44e1918a 1538
fbf5a39b 1539 Orig_Element :=
7e98a4c6
VC		 1540 In_Tree.Array_Elements.Table
1541 (Orig_Element).Next;
fbf5a39b
AC		 1542 end loop;
1543
1544 -- Make sure that the array ends here, in case there
1545 -- previously a greater number of elements.
1546
7e98a4c6
VC		 1547 In_Tree.Array_Elements.Table
1548 (New_Element).Next := No_Array_Element;
b30668b7 1549 end if;
fbf5a39b 1550 end;
b30668b7 1551
fbf5a39b
AC		 1552 -- Declarations other that full associative arrays
1553
1554 else
1555 declare
1556 New_Value : constant Variable_Value :=
1557 Expression
7e98a4c6
VC		 1558 (Project => Project,
1559 In_Tree => In_Tree,
1560 From_Project_Node => From_Project_Node,
1561 From_Project_Node_Tree => From_Project_Node_Tree,
1562 Pkg => Pkg,
1563 First_Term =>
1564 Tree.First_Term
1565 (Expression_Of
1566 (Current_Item, From_Project_Node_Tree),
1567 From_Project_Node_Tree),
1568 Kind =>
1569 Expression_Kind_Of
1570 (Current_Item, From_Project_Node_Tree));
fbf5a39b
AC		 1571 -- The expression value
1572
1573 The_Variable : Variable_Id := No_Variable;
1574
1575 Current_Item_Name : constant Name_Id :=
7e98a4c6 1576 Name_Of (Current_Item, From_Project_Node_Tree);
19235870 1577
fbf5a39b
AC		 1578 begin
1579 -- Process a typed variable declaration
19235870 1580
7e98a4c6
VC		 1581 if Kind_Of (Current_Item, From_Project_Node_Tree) =
1582 N_Typed_Variable_Declaration
fbf5a39b
AC		 1583 then
1584 -- Report an error for an empty string
19235870 1585
fbf5a39b 1586 if New_Value.Value = Empty_String then
7e98a4c6
VC		 1587 Error_Msg_Name_1 :=
1588 Name_Of (Current_Item, From_Project_Node_Tree);
19235870 1589
fbf5a39b
AC		 1590 if Error_Report = null then
1591 Error_Msg
1592 ("no value defined for %",
7e98a4c6
VC		 1593 Location_Of
1594 (Current_Item, From_Project_Node_Tree));
fbf5a39b
AC		 1595
1596 else
1597 Error_Report
1598 ("no value defined for " &
1599 Get_Name_String (Error_Msg_Name_1),
7e98a4c6 1600 Project, In_Tree);
fbf5a39b 1601 end if;
19235870
RK		 1602
1603 else
fbf5a39b
AC		 1604 declare
1605 Current_String : Project_Node_Id :=
7e98a4c6
VC		 1606 First_Literal_String
1607 (String_Type_Of
1608 (Current_Item,
1609 From_Project_Node_Tree),
1610 From_Project_Node_Tree);
fbf5a39b
AC		 1611
1612 begin
7e98a4c6
VC		 1613 -- Loop through all the valid strings for the
1614 -- string type and compare to the string value.
fbf5a39b
AC		 1615
1616 while Current_String /= Empty_Node
7e98a4c6
VC		 1617 and then
1618 String_Value_Of
1619 (Current_String, From_Project_Node_Tree) /=
1620 New_Value.Value
fbf5a39b
AC		 1621 loop
1622 Current_String :=
7e98a4c6
VC		 1623 Next_Literal_String
1624 (Current_String, From_Project_Node_Tree);
fbf5a39b
AC		 1625 end loop;
1626
1627 -- Report an error if the string value is not
1628 -- one for the string type.
1629
1630 if Current_String = Empty_Node then
1631 Error_Msg_Name_1 := New_Value.Value;
7e98a4c6
VC		 1632 Error_Msg_Name_2 :=
1633 Name_Of
1634 (Current_Item, From_Project_Node_Tree);
fbf5a39b
AC		 1635
1636 if Error_Report = null then
1637 Error_Msg
1638 ("value { is illegal for typed string %",
7e98a4c6
VC		 1639 Location_Of
1640 (Current_Item,
1641 From_Project_Node_Tree));
fbf5a39b
AC		 1642
1643 else
1644 Error_Report
1645 ("value """ &
1646 Get_Name_String (Error_Msg_Name_1) &
1647 """ is illegal for typed string """ &
1648 Get_Name_String (Error_Msg_Name_2) &
1649 """",
7e98a4c6 1650 Project, In_Tree);
fbf5a39b
AC		 1651 end if;
1652 end if;
1653 end;
19235870 1654 end if;
fbf5a39b 1655 end if;
19235870 1656
7e98a4c6
VC		 1657 if Kind_Of (Current_Item, From_Project_Node_Tree) /=
1658 N_Attribute_Declaration
fbf5a39b 1659 or else
7e98a4c6
VC		 1660 Associative_Array_Index_Of
1661 (Current_Item, From_Project_Node_Tree) = No_Name
fbf5a39b
AC		 1662 then
1663 -- Case of a variable declaration or of a not
1664 -- associative array attribute.
19235870 1665
fbf5a39b
AC		 1666 -- First, find the list where to find the variable
1667 -- or attribute.
19235870 1668
7e98a4c6
VC		 1669 if Kind_Of (Current_Item, From_Project_Node_Tree) =
1670 N_Attribute_Declaration
fbf5a39b 1671 then
19235870 1672 if Pkg /= No_Package then
fbf5a39b 1673 The_Variable :=
7e98a4c6
VC		 1674 In_Tree.Packages.Table
1675 (Pkg).Decl.Attributes;
19235870 1676 else
fbf5a39b 1677 The_Variable :=
7e98a4c6
VC		 1678 In_Tree.Projects.Table
1679 (Project).Decl.Attributes;
19235870
RK		 1680 end if;
1681
1682 else
fbf5a39b
AC		 1683 if Pkg /= No_Package then
1684 The_Variable :=
7e98a4c6
VC		 1685 In_Tree.Packages.Table
1686 (Pkg).Decl.Variables;
fbf5a39b
AC		 1687 else
1688 The_Variable :=
7e98a4c6
VC		 1689 In_Tree.Projects.Table
1690 (Project).Decl.Variables;
fbf5a39b
AC		 1691 end if;
1692
19235870
RK		 1693 end if;
1694
fbf5a39b
AC		 1695 -- Loop through the list, to find if it has already
1696 -- been declared.
1697
7e98a4c6 1698 while The_Variable /= No_Variable
19235870 1699 and then
7e98a4c6
VC		 1700 In_Tree.Variable_Elements.Table
1701 (The_Variable).Name /= Current_Item_Name
19235870 1702 loop
fbf5a39b 1703 The_Variable :=
7e98a4c6
VC		 1704 In_Tree.Variable_Elements.Table
1705 (The_Variable).Next;
19235870
RK		 1706 end loop;
1707
fbf5a39b
AC		 1708 -- If it has not been declared, create a new entry
1709 -- in the list.
1710
1711 if The_Variable = No_Variable then
7e98a4c6 1712
fbf5a39b
AC		 1713 -- All single string attribute should already have
1714 -- been declared with a default empty string value.
1715
1716 pragma Assert
7e98a4c6 1717 (Kind_Of (Current_Item, From_Project_Node_Tree) /=
fbf5a39b
AC		 1718 N_Attribute_Declaration,
1719 "illegal attribute declaration");
1720
7e98a4c6
VC		 1721 Variable_Element_Table.Increment_Last
1722 (In_Tree.Variable_Elements);
1723 The_Variable := Variable_Element_Table.Last
1724 (In_Tree.Variable_Elements);
fbf5a39b
AC		 1725
1726 -- Put the new variable in the appropriate list
1727
1728 if Pkg /= No_Package then
7e98a4c6 1729 In_Tree.Variable_Elements.Table (The_Variable) :=
fbf5a39b 1730 (Next =>
7e98a4c6
VC		 1731 In_Tree.Packages.Table
1732 (Pkg).Decl.Variables,
fbf5a39b
AC		 1733 Name => Current_Item_Name,
1734 Value => New_Value);
7e98a4c6
VC		 1735 In_Tree.Packages.Table
1736 (Pkg).Decl.Variables := The_Variable;
fbf5a39b
AC		 1737
1738 else
7e98a4c6 1739 In_Tree.Variable_Elements.Table (The_Variable) :=
fbf5a39b 1740 (Next =>
7e98a4c6
VC		 1741 In_Tree.Projects.Table
1742 (Project).Decl.Variables,
fbf5a39b
AC		 1743 Name => Current_Item_Name,
1744 Value => New_Value);
7e98a4c6
VC		 1745 In_Tree.Projects.Table
1746 (Project).Decl.Variables :=
1747 The_Variable;
fbf5a39b
AC		 1748 end if;
1749
1750 -- If the variable/attribute has already been
1751 -- declared, just change the value.
19235870
RK		 1752
1753 else
7e98a4c6
VC		 1754 In_Tree.Variable_Elements.Table
1755 (The_Variable).Value :=
1756 New_Value;
fbf5a39b 1757
19235870 1758 end if;
fbf5a39b
AC		 1759
1760 else
1761 -- Associative array attribute
1762
1763 -- Get the string index
1764
1765 Get_Name_String
7e98a4c6
VC		 1766 (Associative_Array_Index_Of
1767 (Current_Item, From_Project_Node_Tree));
fbf5a39b
AC		 1768
1769 -- Put in lower case, if necessary
1770
7e98a4c6
VC		 1771 if Case_Insensitive
1772 (Current_Item, From_Project_Node_Tree)
1773 then
fbf5a39b
AC		 1774 GNAT.Case_Util.To_Lower
1775 (Name_Buffer (1 .. Name_Len));
1776 end if;
1777
1778 declare
1779 The_Array : Array_Id;
1780
1781 The_Array_Element : Array_Element_Id :=
7e98a4c6 1782 No_Array_Element;
fbf5a39b
AC		 1783
1784 Index_Name : constant Name_Id := Name_Find;
1785 -- The name id of the index
1786
1787 begin
1788 -- Look for the array in the appropriate list
1789
1790 if Pkg /= No_Package then
7e98a4c6
VC		 1791 The_Array := In_Tree.Packages.Table
1792 (Pkg).Decl.Arrays;
fbf5a39b
AC		 1793
1794 else
7e98a4c6 1795 The_Array := In_Tree.Projects.Table
fbf5a39b
AC		 1796 (Project).Decl.Arrays;
1797 end if;
1798
1799 while
1800 The_Array /= No_Array
7e98a4c6
VC		 1801 and then In_Tree.Arrays.Table
1802 (The_Array).Name /= Current_Item_Name
fbf5a39b 1803 loop
7e98a4c6
VC		 1804 The_Array := In_Tree.Arrays.Table
1805 (The_Array).Next;
fbf5a39b
AC		 1806 end loop;
1807
1808 -- If the array cannot be found, create a new
1809 -- entry in the list. As The_Array_Element is
1810 -- initialized to No_Array_Element, a new element
1811 -- will be created automatically later.
1812
1813 if The_Array = No_Array then
7e98a4c6
VC		 1814 Array_Table.Increment_Last
1815 (In_Tree.Arrays);
1816 The_Array := Array_Table.Last
1817 (In_Tree.Arrays);
fbf5a39b
AC		 1818
1819 if Pkg /= No_Package then
7e98a4c6
VC		 1820 In_Tree.Arrays.Table
1821 (The_Array) :=
fbf5a39b
AC		 1822 (Name => Current_Item_Name,
1823 Value => No_Array_Element,
7e98a4c6
VC		 1824 Next =>
1825 In_Tree.Packages.Table
1826 (Pkg).Decl.Arrays);
1827
1828 In_Tree.Packages.Table
1829 (Pkg).Decl.Arrays :=
1830 The_Array;
fbf5a39b
AC		 1831
1832 else
7e98a4c6
VC		 1833 In_Tree.Arrays.Table
1834 (The_Array) :=
fbf5a39b
AC		 1835 (Name => Current_Item_Name,
1836 Value => No_Array_Element,
1837 Next =>
7e98a4c6
VC		 1838 In_Tree.Projects.Table
1839 (Project).Decl.Arrays);
1840
1841 In_Tree.Projects.Table
1842 (Project).Decl.Arrays :=
1843 The_Array;
fbf5a39b
AC		 1844 end if;
1845
1846 -- Otherwise, initialize The_Array_Element as the
1847 -- head of the element list.
1848
1849 else
1850 The_Array_Element :=
7e98a4c6
VC		 1851 In_Tree.Arrays.Table
1852 (The_Array).Value;
fbf5a39b
AC		 1853 end if;
1854
1855 -- Look in the list, if any, to find an element
1856 -- with the same index.
1857
1858 while The_Array_Element /= No_Array_Element
1859 and then
7e98a4c6
VC		 1860 In_Tree.Array_Elements.Table
1861 (The_Array_Element).Index /= Index_Name
fbf5a39b
AC		 1862 loop
1863 The_Array_Element :=
7e98a4c6
VC		 1864 In_Tree.Array_Elements.Table
1865 (The_Array_Element).Next;
fbf5a39b
AC		 1866 end loop;
1867
1868 -- If no such element were found, create a new
1869 -- one and insert it in the element list, with
1870 -- the propoer value.
1871
1872 if The_Array_Element = No_Array_Element then
7e98a4c6
VC		 1873 Array_Element_Table.Increment_Last
1874 (In_Tree.Array_Elements);
1875 The_Array_Element := Array_Element_Table.Last
1876 (In_Tree.Array_Elements);
fbf5a39b 1877
7e98a4c6
VC		 1878 In_Tree.Array_Elements.Table
1879 (The_Array_Element) :=
fbf5a39b 1880 (Index => Index_Name,
7e98a4c6
VC		 1881 Src_Index =>
1882 Source_Index_Of
1883 (Current_Item, From_Project_Node_Tree),
fbf5a39b 1884 Index_Case_Sensitive =>
7e98a4c6
VC		 1885 not Case_Insensitive
1886 (Current_Item, From_Project_Node_Tree),
fbf5a39b 1887 Value => New_Value,
7e98a4c6
VC		 1888 Next => In_Tree.Arrays.Table
1889 (The_Array).Value);
1890 In_Tree.Arrays.Table
1891 (The_Array).Value := The_Array_Element;
fbf5a39b
AC		 1892
1893 -- An element with the same index already exists,
1894 -- just replace its value with the new one.
1895
1896 else
7e98a4c6
VC		 1897 In_Tree.Array_Elements.Table
1898 (The_Array_Element).Value := New_Value;
fbf5a39b
AC		 1899 end if;
1900 end;
1901 end if;
1902 end;
1903 end if;
19235870
RK		 1904
1905 when N_Case_Construction =>
1906 declare
1907 The_Project : Project_Id := Project;
fbf5a39b
AC		 1908 -- The id of the project of the case variable
1909
19235870 1910 The_Package : Package_Id := Pkg;
fbf5a39b
AC		 1911 -- The id of the package, if any, of the case variable
1912
19235870 1913 The_Variable : Variable_Value := Nil_Variable_Value;
fbf5a39b
AC		 1914 -- The case variable
1915
1916 Case_Value : Name_Id := No_Name;
1917 -- The case variable value
1918
19235870
RK		 1919 Case_Item : Project_Node_Id := Empty_Node;
1920 Choice_String : Project_Node_Id := Empty_Node;
1921 Decl_Item : Project_Node_Id := Empty_Node;
1922
1923 begin
1924 declare
1925 Variable_Node : constant Project_Node_Id :=
1926 Case_Variable_Reference_Of
7e98a4c6
VC		 1927 (Current_Item,
1928 From_Project_Node_Tree);
19235870
RK		 1929
1930 Var_Id : Variable_Id := No_Variable;
1931 Name : Name_Id := No_Name;
1932
1933 begin
fbf5a39b
AC		 1934 -- If a project were specified for the case variable,
1935 -- get its id.
1936
7e98a4c6
VC		 1937 if Project_Node_Of
1938 (Variable_Node, From_Project_Node_Tree) /= Empty_Node
1939 then
1940 Name :=
1941 Name_Of
1942 (Project_Node_Of
1943 (Variable_Node, From_Project_Node_Tree),
1944 From_Project_Node_Tree);
19235870 1945 The_Project :=
7e98a4c6
VC		 1946 Imported_Or_Extended_Project_From
1947 (Project, In_Tree, Name);
19235870
RK		 1948 end if;
1949
fbf5a39b
AC		 1950 -- If a package were specified for the case variable,
1951 -- get its id.
1952
7e98a4c6
VC		 1953 if Package_Node_Of
1954 (Variable_Node, From_Project_Node_Tree) /= Empty_Node
1955 then
1956 Name :=
1957 Name_Of
1958 (Package_Node_Of
1959 (Variable_Node, From_Project_Node_Tree),
1960 From_Project_Node_Tree);
1961 The_Package :=
1962 Package_From (The_Project, In_Tree, Name);
19235870
RK		 1963 end if;
1964
7e98a4c6 1965 Name := Name_Of (Variable_Node, From_Project_Node_Tree);
19235870 1966
fbf5a39b
AC		 1967 -- First, look for the case variable into the package,
1968 -- if any.
1969
19235870 1970 if The_Package /= No_Package then
7e98a4c6
VC		 1971 Var_Id := In_Tree.Packages.Table
1972 (The_Package).Decl.Variables;
1973 Name :=
1974 Name_Of (Variable_Node, From_Project_Node_Tree);
19235870
RK		 1975 while Var_Id /= No_Variable
1976 and then
7e98a4c6
VC		 1977 In_Tree.Variable_Elements.Table
1978 (Var_Id).Name /= Name
19235870 1979 loop
7e98a4c6
VC		 1980 Var_Id := In_Tree.Variable_Elements.
1981 Table (Var_Id).Next;
19235870
RK		 1982 end loop;
1983 end if;
1984
fbf5a39b
AC		 1985 -- If not found in the package, or if there is no
1986 -- package, look at the project level.
1987
19235870 1988 if Var_Id = No_Variable
7e98a4c6
VC		 1989 and then
1990 Package_Node_Of
1991 (Variable_Node, From_Project_Node_Tree) = Empty_Node
19235870 1992 then
7e98a4c6
VC		 1993 Var_Id := In_Tree.Projects.Table
1994 (The_Project).Decl.Variables;
19235870
RK		 1995 while Var_Id /= No_Variable
1996 and then
7e98a4c6
VC		 1997 In_Tree.Variable_Elements.Table
1998 (Var_Id).Name /= Name
19235870 1999 loop
7e98a4c6
VC		 2000 Var_Id := In_Tree.Variable_Elements.
2001 Table (Var_Id).Next;
19235870
RK		 2002 end loop;
2003 end if;
2004
2005 if Var_Id = No_Variable then
2006
fbf5a39b
AC		 2007 -- Should never happen, because this has already been
2008 -- checked during parsing.
19235870
RK		 2009
2010 Write_Line ("variable """ &
2011 Get_Name_String (Name) &
2012 """ not found");
2013 raise Program_Error;
2014 end if;
2015
fbf5a39b
AC		 2016 -- Get the case variable
2017
7e98a4c6
VC		 2018 The_Variable := In_Tree.Variable_Elements.
2019 Table (Var_Id).Value;
19235870
RK		 2020
2021 if The_Variable.Kind /= Single then
2022
fbf5a39b
AC		 2023 -- Should never happen, because this has already been
2024 -- checked during parsing.
19235870
RK		 2025
2026 Write_Line ("variable""" &
2027 Get_Name_String (Name) &
2028 """ is not a single string variable");
2029 raise Program_Error;
2030 end if;
2031
fbf5a39b 2032 -- Get the case variable value
19235870
RK		 2033 Case_Value := The_Variable.Value;
2034 end;
2035
fbf5a39b
AC		 2036 -- Now look into all the case items of the case construction
2037
7e98a4c6
VC		 2038 Case_Item :=
2039 First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
19235870
RK		 2040 Case_Item_Loop :
2041 while Case_Item /= Empty_Node loop
7e98a4c6
VC		 2042 Choice_String :=
2043 First_Choice_Of (Case_Item, From_Project_Node_Tree);
19235870 2044
fbf5a39b
AC		 2045 -- When Choice_String is nil, it means that it is
2046 -- the "when others =>" alternative.
2047
19235870 2048 if Choice_String = Empty_Node then
7e98a4c6
VC		 2049 Decl_Item :=
2050 First_Declarative_Item_Of
2051 (Case_Item, From_Project_Node_Tree);
19235870
RK		 2052 exit Case_Item_Loop;
2053 end if;
2054
fbf5a39b
AC		 2055 -- Look into all the alternative of this case item
2056
19235870
RK		 2057 Choice_Loop :
2058 while Choice_String /= Empty_Node loop
7e98a4c6
VC		 2059 if Case_Value =
2060 String_Value_Of
2061 (Choice_String, From_Project_Node_Tree)
19235870
RK		 2062 then
2063 Decl_Item :=
7e98a4c6
VC		 2064 First_Declarative_Item_Of
2065 (Case_Item, From_Project_Node_Tree);
19235870
RK		 2066 exit Case_Item_Loop;
2067 end if;
2068
2069 Choice_String :=
7e98a4c6
VC		 2070 Next_Literal_String
2071 (Choice_String, From_Project_Node_Tree);
19235870 2072 end loop Choice_Loop;
7e98a4c6
VC		 2073
2074 Case_Item :=
2075 Next_Case_Item (Case_Item, From_Project_Node_Tree);
19235870
RK		 2076 end loop Case_Item_Loop;
2077
fbf5a39b
AC		 2078 -- If there is an alternative, then we process it
2079
19235870
RK		 2080 if Decl_Item /= Empty_Node then
2081 Process_Declarative_Items
7e98a4c6
VC		 2082 (Project => Project,
2083 In_Tree => In_Tree,
2084 From_Project_Node => From_Project_Node,
2085 From_Project_Node_Tree => From_Project_Node_Tree,
2086 Pkg => Pkg,
2087 Item => Decl_Item);
19235870
RK		 2088 end if;
2089 end;
2090
2091 when others =>
2092
2093 -- Should never happen
2094
2095 Write_Line ("Illegal declarative item: " &
7e98a4c6
VC		 2096 Project_Node_Kind'Image
2097 (Kind_Of
2098 (Current_Item, From_Project_Node_Tree)));
19235870
RK		 2099 raise Program_Error;
2100 end case;
2101 end loop;
2102 end Process_Declarative_Items;
2103
2104 ---------------------
2105 -- Recursive_Check --
2106 ---------------------
2107
7324bf49
AC		 2108 procedure Recursive_Check
2109 (Project : Project_Id;
7e98a4c6 2110 In_Tree : Project_Tree_Ref;
7324bf49
AC		 2111 Follow_Links : Boolean)
2112 is
19235870
RK		 2113 Data : Project_Data;
2114 Imported_Project_List : Project_List := Empty_Project_List;
2115
2116 begin
2117 -- Do nothing if Project is No_Project, or Project has already
2118 -- been marked as checked.
2119
2120 if Project /= No_Project
7e98a4c6 2121 and then not In_Tree.Projects.Table (Project).Checked
19235870 2122 then
fbf5a39b
AC		 2123 -- Mark project as checked, to avoid infinite recursion in
2124 -- ill-formed trees, where a project imports itself.
2125
7e98a4c6 2126 In_Tree.Projects.Table (Project).Checked := True;
fbf5a39b 2127
7e98a4c6 2128 Data := In_Tree.Projects.Table (Project);
19235870 2129
fbf5a39b
AC		 2130 -- Call itself for a possible extended project.
2131 -- (if there is no extended project, then nothing happens).
19235870 2132
7e98a4c6 2133 Recursive_Check (Data.Extends, In_Tree, Follow_Links);
19235870
RK		 2134
2135 -- Call itself for all imported projects
2136
2137 Imported_Project_List := Data.Imported_Projects;
2138 while Imported_Project_List /= Empty_Project_List loop
2139 Recursive_Check
7e98a4c6
VC		 2140 (In_Tree.Project_Lists.Table
2141 (Imported_Project_List).Project,
2142 In_Tree, Follow_Links);
19235870 2143 Imported_Project_List :=
7e98a4c6
VC		 2144 In_Tree.Project_Lists.Table
2145 (Imported_Project_List).Next;
19235870
RK		 2146 end loop;
2147
19235870
RK		 2148 if Opt.Verbose_Mode then
2149 Write_Str ("Checking project file """);
2150 Write_Str (Get_Name_String (Data.Name));
2151 Write_Line ("""");
2152 end if;
2153
7e98a4c6 2154 Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links);
19235870 2155 end if;
19235870
RK		 2156 end Recursive_Check;
2157
2158 -----------------------
2159 -- Recursive_Process --
2160 -----------------------
2161
2162 procedure Recursive_Process
7e98a4c6
VC		 2163 (In_Tree : Project_Tree_Ref;
2164 Project : out Project_Id;
2165 From_Project_Node : Project_Node_Id;
2166 From_Project_Node_Tree : Project_Node_Tree_Ref;
2167 Extended_By : Project_Id)
19235870
RK		 2168 is
2169 With_Clause : Project_Node_Id;
2170
2171 begin
2172 if From_Project_Node = Empty_Node then
2173 Project := No_Project;
2174
2175 else
2176 declare
7e98a4c6 2177 Processed_Data : Project_Data := Empty_Project (In_Tree);
b5e792e2
AC		 2178 Imported : Project_List := Empty_Project_List;
2179 Declaration_Node : Project_Node_Id := Empty_Node;
c8b0c260 2180 Tref : Source_Buffer_Ptr;
7e98a4c6 2181 Name : constant Name_Id :=
c8b0c260
VC		 2182 Name_Of
2183 (From_Project_Node, From_Project_Node_Tree);
2184 Location : Source_Ptr :=
2185 Location_Of
2186 (From_Project_Node, From_Project_Node_Tree);
2187
19235870
RK		 2188
2189 begin
2190 Project := Processed_Projects.Get (Name);
2191
2192 if Project /= No_Project then
2193 return;
2194 end if;
2195
7e98a4c6
VC		 2196 Project_Table.Increment_Last (In_Tree.Projects);
2197 Project := Project_Table.Last (In_Tree.Projects);
19235870 2198 Processed_Projects.Set (Name, Project);
07fc65c4 2199
fbf5a39b
AC		 2200 Processed_Data.Name := Name;
2201
9596236a
AC		 2202 Get_Name_String (Name);
2203
2204 -- If name starts with the virtual prefix, flag the project as
2205 -- being a virtual extending project.
2206
2207 if Name_Len > Virtual_Prefix'Length
2208 and then Name_Buffer (1 .. Virtual_Prefix'Length) =
2209 Virtual_Prefix
2210 then
2211 Processed_Data.Virtual := True;
c8b0c260
VC		 2212 Processed_Data.Display_Name := Name;
2213
2214 -- If there is no file, for example when the project node tree is
2215 -- built in memory by GPS, the Display_Name cannot be found in
2216 -- the source, so its value is the same as Name.
2217
2218 elsif Location = No_Location then
2219 Processed_Data.Display_Name := Name;
2220
2221 -- Get the spelling of the project name from the project file
2222
2223 else
2224 Tref := Source_Text (Get_Source_File_Index (Location));
2225
2226 for J in 1 .. Name_Len loop
2227 Name_Buffer (J) := Tref (Location);
2228 Location := Location + 1;
2229 end loop;
2230
2231 Processed_Data.Display_Name := Name_Find;
9596236a
AC		 2232 end if;
2233
fbf5a39b 2234 Processed_Data.Display_Path_Name :=
7e98a4c6 2235 Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
fbf5a39b
AC		 2236 Get_Name_String (Processed_Data.Display_Path_Name);
2237 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2238 Processed_Data.Path_Name := Name_Find;
2239
7e98a4c6
VC		 2240 Processed_Data.Location :=
2241 Location_Of (From_Project_Node, From_Project_Node_Tree);
fbf5a39b
AC		 2242
2243 Processed_Data.Display_Directory :=
7e98a4c6 2244 Directory_Of (From_Project_Node, From_Project_Node_Tree);
fbf5a39b
AC		 2245 Get_Name_String (Processed_Data.Display_Directory);
2246 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2247 Processed_Data.Directory := Name_Find;
2248
2249 Processed_Data.Extended_By := Extended_By;
07fc65c4 2250
7e98a4c6
VC		 2251 Add_Attributes
2252 (Project, In_Tree, Processed_Data.Decl, Attribute_First);
2253 With_Clause :=
2254 First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
19235870
RK		 2255
2256 while With_Clause /= Empty_Node loop
2257 declare
2258 New_Project : Project_Id;
2259 New_Data : Project_Data;
2260
2261 begin
2262 Recursive_Process
7e98a4c6
VC		 2263 (In_Tree => In_Tree,
2264 Project => New_Project,
2265 From_Project_Node =>
2266 Project_Node_Of (With_Clause, From_Project_Node_Tree),
2267 From_Project_Node_Tree => From_Project_Node_Tree,
2268 Extended_By => No_Project);
2269 New_Data :=
2270 In_Tree.Projects.Table (New_Project);
19235870
RK		 2271
2272 -- If we were the first project to import it,
2273 -- set First_Referred_By to us.
2274
2275 if New_Data.First_Referred_By = No_Project then
2276 New_Data.First_Referred_By := Project;
7e98a4c6
VC		 2277 In_Tree.Projects.Table (New_Project) :=
2278 New_Data;
19235870
RK		 2279 end if;
2280
2281 -- Add this project to our list of imported projects
2282
7e98a4c6
VC		 2283 Project_List_Table.Increment_Last
2284 (In_Tree.Project_Lists);
2285 In_Tree.Project_Lists.Table
2286 (Project_List_Table.Last
2287 (In_Tree.Project_Lists)) :=
19235870
RK		 2288 (Project => New_Project, Next => Empty_Project_List);
2289
2290 -- Imported is the id of the last imported project.
2291 -- If it is nil, then this imported project is our first.
2292
2293 if Imported = Empty_Project_List then
7e98a4c6
VC		 2294 Processed_Data.Imported_Projects :=
2295 Project_List_Table.Last
2296 (In_Tree.Project_Lists);
19235870
RK		 2297
2298 else
7e98a4c6
VC		 2299 In_Tree.Project_Lists.Table
2300 (Imported).Next := Project_List_Table.Last
2301 (In_Tree.Project_Lists);
19235870
RK		 2302 end if;
2303
7e98a4c6
VC		 2304 Imported := Project_List_Table.Last
2305 (In_Tree.Project_Lists);
19235870 2306
7e98a4c6
VC		 2307 With_Clause :=
2308 Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
19235870
RK		 2309 end;
2310 end loop;
2311
7e98a4c6
VC		 2312 Declaration_Node :=
2313 Project_Declaration_Of
2314 (From_Project_Node, From_Project_Node_Tree);
19235870
RK		 2315
2316 Recursive_Process
7e98a4c6
VC		 2317 (In_Tree => In_Tree,
2318 Project => Processed_Data.Extends,
2319 From_Project_Node =>
2320 Extended_Project_Of
2321 (Declaration_Node, From_Project_Node_Tree),
2322 From_Project_Node_Tree => From_Project_Node_Tree,
2323 Extended_By => Project);
19235870 2324
7e98a4c6 2325 In_Tree.Projects.Table (Project) := Processed_Data;
19235870
RK		 2326
2327 Process_Declarative_Items
7e98a4c6
VC		 2328 (Project => Project,
2329 In_Tree => In_Tree,
2330 From_Project_Node => From_Project_Node,
2331 From_Project_Node_Tree => From_Project_Node_Tree,
2332 Pkg => No_Package,
2333 Item =>
2334 First_Declarative_Item_Of
2335 (Declaration_Node, From_Project_Node_Tree));
19235870 2336
fbf5a39b
AC		 2337 -- If it is an extending project, inherit all packages
2338 -- from the extended project that are not explicitely defined
b5e792e2
AC		 2339 -- or renamed. Also inherit the languages, if attribute Languages
2340 -- is not explicitely defined.
fbf5a39b
AC		 2341
2342 if Processed_Data.Extends /= No_Project then
7e98a4c6 2343 Processed_Data := In_Tree.Projects.Table (Project);
fbf5a39b
AC		 2344
2345 declare
2346 Extended_Pkg : Package_Id :=
7e98a4c6 2347 In_Tree.Projects.Table
fbf5a39b
AC		 2348 (Processed_Data.Extends).Decl.Packages;
2349 Current_Pkg : Package_Id;
2350 Element : Package_Element;
2351 First : constant Package_Id :=
2352 Processed_Data.Decl.Packages;
b5e792e2
AC		 2353 Attribute1 : Variable_Id;
2354 Attribute2 : Variable_Id;
2355 Attr_Value1 : Variable;
2356 Attr_Value2 : Variable;
fbf5a39b
AC		 2357
2358 begin
2359 while Extended_Pkg /= No_Package loop
7e98a4c6
VC		 2360 Element :=
2361 In_Tree.Packages.Table (Extended_Pkg);
fbf5a39b
AC		 2362
2363 Current_Pkg := First;
2364
2365 loop
2366 exit when Current_Pkg = No_Package
7e98a4c6
VC		 2367 or else In_Tree.Packages.Table
2368 (Current_Pkg).Name = Element.Name;
2369 Current_Pkg := In_Tree.Packages.Table
2370 (Current_Pkg).Next;
fbf5a39b
AC		 2371 end loop;
2372
2373 if Current_Pkg = No_Package then
7e98a4c6
VC		 2374 Package_Table.Increment_Last
2375 (In_Tree.Packages);
2376 Current_Pkg := Package_Table.Last
2377 (In_Tree.Packages);
2378 In_Tree.Packages.Table (Current_Pkg) :=
fbf5a39b
AC		 2379 (Name => Element.Name,
2380 Decl => Element.Decl,
2381 Parent => No_Package,
2382 Next => Processed_Data.Decl.Packages);
2383 Processed_Data.Decl.Packages := Current_Pkg;
2384 end if;
2385
2386 Extended_Pkg := Element.Next;
2387 end loop;
b5e792e2
AC		 2388
2389 -- Check if attribute Languages is declared in the
2390 -- extending project.
2391
2392 Attribute1 := Processed_Data.Decl.Attributes;
2393 while Attribute1 /= No_Variable loop
7e98a4c6
VC		 2394 Attr_Value1 := In_Tree.Variable_Elements.
2395 Table (Attribute1);
b5e792e2
AC		 2396 exit when Attr_Value1.Name = Snames.Name_Languages;
2397 Attribute1 := Attr_Value1.Next;
2398 end loop;
2399
2400 if Attribute1 = No_Variable or else
2401 Attr_Value1.Value.Default
2402 then
2403 -- Attribute Languages is not declared in the extending
2404 -- project. Check if it is declared in the project being
2405 -- extended.
2406
2407 Attribute2 :=
7e98a4c6
VC		 2408 In_Tree.Projects.Table
2409 (Processed_Data.Extends).Decl.Attributes;
b5e792e2
AC		 2410
2411 while Attribute2 /= No_Variable loop
7e98a4c6
VC		 2412 Attr_Value2 := In_Tree.Variable_Elements.
2413 Table (Attribute2);
b5e792e2
AC		 2414 exit when Attr_Value2.Name = Snames.Name_Languages;
2415 Attribute2 := Attr_Value2.Next;
2416 end loop;
2417
2418 if Attribute2 /= No_Variable and then
2419 not Attr_Value2.Value.Default
2420 then
2421 -- As attribute Languages is declared in the project
2422 -- being extended, copy its value for the extending
2423 -- project.
2424
2425 if Attribute1 = No_Variable then
7e98a4c6
VC		 2426 Variable_Element_Table.Increment_Last
2427 (In_Tree.Variable_Elements);
2428 Attribute1 := Variable_Element_Table.Last
2429 (In_Tree.Variable_Elements);
b5e792e2
AC		 2430 Attr_Value1.Next := Processed_Data.Decl.Attributes;
2431 Processed_Data.Decl.Attributes := Attribute1;
2432 end if;
2433
2434 Attr_Value1.Name := Snames.Name_Languages;
2435 Attr_Value1.Value := Attr_Value2.Value;
7e98a4c6
VC		 2436 In_Tree.Variable_Elements.Table
2437 (Attribute1) := Attr_Value1;
b5e792e2
AC		 2438 end if;
2439 end if;
fbf5a39b
AC		 2440 end;
2441
7e98a4c6 2442 In_Tree.Projects.Table (Project) := Processed_Data;
fbf5a39b 2443 end if;
19235870
RK		 2444 end;
2445 end if;
2446 end Recursive_Process;
2447
2448end Prj.Proc;
Mirror of https://gcc.gnu.org/git/gcc.git