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