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