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