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