1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Err_Vars
; use Err_Vars
;
28 with Namet
; use Namet
;
30 with Osint
; use Osint
;
31 with Output
; use Output
;
32 with Prj
.Attr
; use Prj
.Attr
;
33 with Prj
.Com
; use Prj
.Com
;
34 with Prj
.Err
; use Prj
.Err
;
35 with Prj
.Ext
; use Prj
.Ext
;
36 with Prj
.Nmsc
; use Prj
.Nmsc
;
39 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
42 package body Prj
.Proc
is
44 Error_Report
: Put_Line_Access
:= null;
46 package Processed_Projects
is new GNAT
.HTable
.Simple_HTable
47 (Header_Num
=> Header_Num
,
48 Element
=> Project_Id
,
49 No_Element
=> No_Project
,
53 -- This hash table contains all processed projects
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.
59 procedure Add_Attributes
60 (Project
: Project_Id
;
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.
67 (Project
: in out Project_Id
;
68 Process_Languages
: Languages_Processed
;
69 Follow_Links
: Boolean);
70 -- Set all projects to not checked, then call Recursive_Check for the
71 -- main project Project. Project is set to No_Project if errors occurred.
72 -- See Prj.Nmsc.Ada_Check for information on Follow_Links.
75 (Project
: Project_Id
;
76 From_Project_Node
: Project_Node_Id
;
78 First_Term
: Project_Node_Id
;
79 Kind
: Variable_Kind
) return Variable_Value
;
80 -- From N_Expression project node From_Project_Node, compute the value
81 -- of an expression and return it as a Variable_Value.
83 function Imported_Or_Extended_Project_From
84 (Project
: Project_Id
;
85 With_Name
: Name_Id
) return Project_Id
;
86 -- Find an imported or extended project of Project whose name is With_Name
89 (Project
: Project_Id
;
90 With_Name
: Name_Id
) return Package_Id
;
91 -- Find the package of Project whose name is With_Name
93 procedure Process_Declarative_Items
94 (Project
: Project_Id
;
95 From_Project_Node
: Project_Node_Id
;
97 Item
: Project_Node_Id
);
98 -- Process declarative items starting with From_Project_Node, and put them
99 -- in declarations Decl. This is a recursive procedure; it calls itself for
100 -- a package declaration or a case construction.
102 procedure Recursive_Process
103 (Project
: out Project_Id
;
104 From_Project_Node
: Project_Node_Id
;
105 Extended_By
: Project_Id
);
106 -- Process project with node From_Project_Node in the tree.
107 -- Do nothing if From_Project_Node is Empty_Node.
108 -- If project has already been processed, simply return its project id.
109 -- Otherwise create a new project id, mark it as processed, call itself
110 -- recursively for all imported projects and a extended project, if any.
111 -- Then process the declarative items of the project.
113 procedure Recursive_Check
114 (Project
: Project_Id
;
115 Process_Languages
: Languages_Processed
;
116 Follow_Links
: Boolean);
117 -- If Project is not marked as checked, mark it as checked, call
118 -- Check_Naming_Scheme for the project, then call itself for a
119 -- possible extended project and all the imported projects of Project.
120 -- See Prj.Nmsc.Ada_Check for information on Follow_Links
126 procedure Add
(To_Exp
: in out Name_Id
; Str
: Name_Id
) is
128 if To_Exp
= Types
.No_Name
or else To_Exp
= Empty_String
then
130 -- To_Exp is nil or empty. The result is Str.
134 -- If Str is nil, then do not change To_Ext
136 elsif Str
/= No_Name
and then Str
/= Empty_String
then
138 S
: constant String := Get_Name_String
(Str
);
141 Get_Name_String
(To_Exp
);
142 Add_Str_To_Name_Buffer
(S
);
152 procedure Add_Attributes
153 (Project
: Project_Id
;
154 Decl
: in out Declarations
;
155 First
: Attribute_Node_Id
)
157 The_Attribute
: Attribute_Node_Id
:= First
;
160 while The_Attribute
/= Empty_Attribute
loop
161 if Attribute_Kind_Of
(The_Attribute
) = Single
then
163 New_Attribute
: Variable_Value
;
166 case Variable_Kind_Of
(The_Attribute
) is
168 -- Undefined should not happen
172 (False, "attribute with an undefined kind");
175 -- Single attributes have a default value of empty string
181 Location
=> No_Location
,
183 Value
=> Empty_String
,
186 -- List attributes have a default value of nil list
192 Location
=> No_Location
,
194 Values
=> Nil_String
);
198 Variable_Elements
.Increment_Last
;
199 Variable_Elements
.Table
(Variable_Elements
.Last
) :=
200 (Next
=> Decl
.Attributes
,
201 Name
=> Attribute_Name_Of
(The_Attribute
),
202 Value
=> New_Attribute
);
203 Decl
.Attributes
:= Variable_Elements
.Last
;
207 The_Attribute
:= Next_Attribute
(After
=> The_Attribute
);
216 (Project
: in out Project_Id
;
217 Process_Languages
: Languages_Processed
;
218 Follow_Links
: Boolean) is
220 -- Make sure that all projects are marked as not checked
222 for Index
in 1 .. Projects
.Last
loop
223 Projects
.Table
(Index
).Checked
:= False;
226 Recursive_Check
(Project
, Process_Languages
, Follow_Links
);
235 (Project
: Project_Id
;
236 From_Project_Node
: Project_Node_Id
;
238 First_Term
: Project_Node_Id
;
239 Kind
: Variable_Kind
) return Variable_Value
241 The_Term
: Project_Node_Id
:= First_Term
;
242 -- The term in the expression list
244 The_Current_Term
: Project_Node_Id
:= Empty_Node
;
245 -- The current term node id
247 Result
: Variable_Value
(Kind
=> Kind
);
248 -- The returned result
250 Last
: String_List_Id
:= Nil_String
;
251 -- Reference to the last string elements in Result, when Kind is List.
254 Result
.Project
:= Project
;
255 Result
.Location
:= Location_Of
(First_Term
);
257 -- Process each term of the expression, starting with First_Term
259 while The_Term
/= Empty_Node
loop
260 The_Current_Term
:= Current_Term
(The_Term
);
262 case Kind_Of
(The_Current_Term
) is
264 when N_Literal_String
=>
270 -- Should never happen
272 pragma Assert
(False, "Undefined expression kind");
276 Add
(Result
.Value
, String_Value_Of
(The_Current_Term
));
277 Result
.Index
:= Source_Index_Of
(The_Current_Term
);
281 String_Elements
.Increment_Last
;
283 if Last
= Nil_String
then
285 -- This can happen in an expression such as
288 Result
.Values
:= String_Elements
.Last
;
291 String_Elements
.Table
(Last
).Next
:=
292 String_Elements
.Last
;
295 Last
:= String_Elements
.Last
;
296 String_Elements
.Table
(Last
) :=
297 (Value
=> String_Value_Of
(The_Current_Term
),
298 Index
=> Source_Index_Of
(The_Current_Term
),
299 Display_Value
=> No_Name
,
300 Location
=> Location_Of
(The_Current_Term
),
306 when N_Literal_String_List
=>
309 String_Node
: Project_Node_Id
:=
310 First_Expression_In_List
(The_Current_Term
);
312 Value
: Variable_Value
;
315 if String_Node
/= Empty_Node
then
317 -- If String_Node is nil, it is an empty list,
318 -- there is nothing to do
322 From_Project_Node
=> From_Project_Node
,
324 First_Term
=> Tree
.First_Term
(String_Node
),
326 String_Elements
.Increment_Last
;
328 if Result
.Values
= Nil_String
then
330 -- This literal string list is the first term
331 -- in a string list expression
333 Result
.Values
:= String_Elements
.Last
;
336 String_Elements
.Table
(Last
).Next
:=
337 String_Elements
.Last
;
340 Last
:= String_Elements
.Last
;
341 String_Elements
.Table
(Last
) :=
342 (Value
=> Value
.Value
,
343 Display_Value
=> No_Name
,
344 Location
=> Value
.Location
,
347 Index
=> Value
.Index
);
350 -- Add the other element of the literal string list
351 -- one after the other
354 Next_Expression_In_List
(String_Node
);
356 exit when String_Node
= Empty_Node
;
361 From_Project_Node
=> From_Project_Node
,
363 First_Term
=> Tree
.First_Term
(String_Node
),
366 String_Elements
.Increment_Last
;
367 String_Elements
.Table
(Last
).Next
:=
368 String_Elements
.Last
;
369 Last
:= String_Elements
.Last
;
370 String_Elements
.Table
(Last
) :=
371 (Value
=> Value
.Value
,
372 Display_Value
=> No_Name
,
373 Location
=> Value
.Location
,
376 Index
=> Value
.Index
);
383 when N_Variable_Reference | N_Attribute_Reference
=>
386 The_Project
: Project_Id
:= Project
;
387 The_Package
: Package_Id
:= Pkg
;
388 The_Name
: Name_Id
:= No_Name
;
389 The_Variable_Id
: Variable_Id
:= No_Variable
;
390 The_Variable
: Variable_Value
;
391 Term_Project
: constant Project_Node_Id
:=
392 Project_Node_Of
(The_Current_Term
);
393 Term_Package
: constant Project_Node_Id
:=
394 Package_Node_Of
(The_Current_Term
);
395 Index
: Name_Id
:= No_Name
;
398 if Term_Project
/= Empty_Node
and then
399 Term_Project
/= From_Project_Node
401 -- This variable or attribute comes from another project
403 The_Name
:= Name_Of
(Term_Project
);
404 The_Project
:= Imported_Or_Extended_Project_From
406 With_Name
=> The_Name
);
409 if Term_Package
/= Empty_Node
then
411 -- This is an attribute of a package
413 The_Name
:= Name_Of
(Term_Package
);
414 The_Package
:= Projects
.Table
(The_Project
).Decl
.Packages
;
416 while The_Package
/= No_Package
417 and then Packages
.Table
(The_Package
).Name
/= The_Name
419 The_Package
:= Packages
.Table
(The_Package
).Next
;
423 (The_Package
/= No_Package
,
424 "package not found.");
426 elsif Kind_Of
(The_Current_Term
) = N_Attribute_Reference
then
427 The_Package
:= No_Package
;
430 The_Name
:= Name_Of
(The_Current_Term
);
432 if Kind_Of
(The_Current_Term
) = N_Attribute_Reference
then
433 Index
:= Associative_Array_Index_Of
(The_Current_Term
);
436 -- If it is not an associative array attribute
438 if Index
= No_Name
then
440 -- It is not an associative array attribute
442 if The_Package
/= No_Package
then
444 -- First, if there is a package, look into the package
447 Kind_Of
(The_Current_Term
) = N_Variable_Reference
450 Packages
.Table
(The_Package
).Decl
.Variables
;
454 Packages
.Table
(The_Package
).Decl
.Attributes
;
457 while The_Variable_Id
/= No_Variable
459 Variable_Elements
.Table
(The_Variable_Id
).Name
/=
463 Variable_Elements
.Table
(The_Variable_Id
).Next
;
468 if The_Variable_Id
= No_Variable
then
470 -- If we have not found it, look into the project
473 Kind_Of
(The_Current_Term
) = N_Variable_Reference
476 Projects
.Table
(The_Project
).Decl
.Variables
;
480 Projects
.Table
(The_Project
).Decl
.Attributes
;
483 while The_Variable_Id
/= No_Variable
485 Variable_Elements
.Table
(The_Variable_Id
).Name
/=
489 Variable_Elements
.Table
(The_Variable_Id
).Next
;
494 pragma Assert
(The_Variable_Id
/= No_Variable
,
495 "variable or attribute not found");
497 The_Variable
:= Variable_Elements
.Table
498 (The_Variable_Id
).Value
;
502 -- It is an associative array attribute
505 The_Array
: Array_Id
:= No_Array
;
506 The_Element
: Array_Element_Id
:= No_Array_Element
;
507 Array_Index
: Name_Id
:= No_Name
;
509 if The_Package
/= No_Package
then
511 Packages
.Table
(The_Package
).Decl
.Arrays
;
515 Projects
.Table
(The_Project
).Decl
.Arrays
;
518 while The_Array
/= No_Array
519 and then Arrays
.Table
(The_Array
).Name
/= The_Name
521 The_Array
:= Arrays
.Table
(The_Array
).Next
;
524 if The_Array
/= No_Array
then
525 The_Element
:= Arrays
.Table
(The_Array
).Value
;
527 Get_Name_String
(Index
);
529 if Case_Insensitive
(The_Current_Term
) then
530 To_Lower
(Name_Buffer
(1 .. Name_Len
));
533 Array_Index
:= Name_Find
;
535 while The_Element
/= No_Array_Element
536 and then Array_Elements
.Table
(The_Element
).Index
540 Array_Elements
.Table
(The_Element
).Next
;
545 if The_Element
/= No_Array_Element
then
547 Array_Elements
.Table
(The_Element
).Value
;
551 Expression_Kind_Of
(The_Current_Term
) = List
556 Location
=> No_Location
,
558 Values
=> Nil_String
);
564 Location
=> No_Location
,
566 Value
=> Empty_String
,
577 -- Should never happen
579 pragma Assert
(False, "undefined expression kind");
584 case The_Variable
.Kind
is
590 Add
(Result
.Value
, The_Variable
.Value
);
594 -- Should never happen
598 "list cannot appear in single " &
599 "string expression");
604 case The_Variable
.Kind
is
610 String_Elements
.Increment_Last
;
612 if Last
= Nil_String
then
614 -- This can happen in an expression such as
617 Result
.Values
:= String_Elements
.Last
;
620 String_Elements
.Table
(Last
).Next
:=
621 String_Elements
.Last
;
624 Last
:= String_Elements
.Last
;
625 String_Elements
.Table
(Last
) :=
626 (Value
=> The_Variable
.Value
,
627 Display_Value
=> No_Name
,
628 Location
=> Location_Of
(The_Current_Term
),
636 The_List
: String_List_Id
:=
640 while The_List
/= Nil_String
loop
641 String_Elements
.Increment_Last
;
643 if Last
= Nil_String
then
644 Result
.Values
:= String_Elements
.Last
;
647 String_Elements
.Table
(Last
).Next
:=
648 String_Elements
.Last
;
652 Last
:= String_Elements
.Last
;
653 String_Elements
.Table
(Last
) :=
655 String_Elements
.Table
657 Display_Value
=> No_Name
,
658 Location
=> Location_Of
664 String_Elements
.Table
(The_List
).Next
;
671 when N_External_Value
=>
673 (String_Value_Of
(External_Reference_Of
(The_Current_Term
)));
676 Name
: constant Name_Id
:= Name_Find
;
677 Default
: Name_Id
:= No_Name
;
678 Value
: Name_Id
:= No_Name
;
680 Default_Node
: constant Project_Node_Id
:=
681 External_Default_Of
(The_Current_Term
);
684 if Default_Node
/= Empty_Node
then
685 Default
:= String_Value_Of
(Default_Node
);
688 Value
:= Prj
.Ext
.Value_Of
(Name
, Default
);
690 if Value
= No_Name
then
691 if not Opt
.Quiet_Output
then
692 if Error_Report
= null then
694 ("?undefined external reference",
695 Location_Of
(The_Current_Term
));
699 ("warning: """ & Get_Name_String
(Name
) &
700 """ is an undefined external reference",
705 Value
:= Empty_String
;
715 Add
(Result
.Value
, Value
);
718 String_Elements
.Increment_Last
;
720 if Last
= Nil_String
then
721 Result
.Values
:= String_Elements
.Last
;
724 String_Elements
.Table
(Last
).Next
:=
725 String_Elements
.Last
;
728 Last
:= String_Elements
.Last
;
729 String_Elements
.Table
(Last
) :=
731 Display_Value
=> No_Name
,
732 Location
=> Location_Of
(The_Current_Term
),
742 -- Should never happen
746 "illegal node kind in an expression");
751 The_Term
:= Next_Term
(The_Term
);
757 ---------------------------------------
758 -- Imported_Or_Extended_Project_From --
759 ---------------------------------------
761 function Imported_Or_Extended_Project_From
762 (Project
: Project_Id
;
763 With_Name
: Name_Id
) return Project_Id
765 Data
: constant Project_Data
:= Projects
.Table
(Project
);
766 List
: Project_List
:= Data
.Imported_Projects
;
769 -- First check if it is the name of a extended project
771 if Data
.Extends
/= No_Project
772 and then Projects
.Table
(Data
.Extends
).Name
= With_Name
777 -- Then check the name of each imported project
779 while List
/= Empty_Project_List
782 (Project_Lists
.Table
(List
).Project
).Name
/= With_Name
785 List
:= Project_Lists
.Table
(List
).Next
;
789 (List
/= Empty_Project_List
,
790 "project not found");
792 return Project_Lists
.Table
(List
).Project
;
794 end Imported_Or_Extended_Project_From
;
800 function Package_From
801 (Project
: Project_Id
;
802 With_Name
: Name_Id
) return Package_Id
804 Data
: constant Project_Data
:= Projects
.Table
(Project
);
805 Result
: Package_Id
:= Data
.Decl
.Packages
;
808 -- Check the name of each existing package of Project
810 while Result
/= No_Package
812 Packages
.Table
(Result
).Name
/= With_Name
814 Result
:= Packages
.Table
(Result
).Next
;
817 if Result
= No_Package
then
818 -- Should never happen
819 Write_Line
("package """ & Get_Name_String
(With_Name
) &
833 (Project
: out Project_Id
;
834 Success
: out Boolean;
835 From_Project_Node
: Project_Node_Id
;
836 Report_Error
: Put_Line_Access
;
837 Process_Languages
: Languages_Processed
:= Ada_Language
;
838 Follow_Links
: Boolean := True)
841 Extending
: Project_Id
;
842 Extending2
: Project_Id
;
845 Error_Report
:= Report_Error
;
848 -- Make sure there is no projects in the data structure
850 Projects
.Set_Last
(No_Project
);
851 Processed_Projects
.Reset
;
853 -- And process the main project and all of the projects it depends on,
858 From_Project_Node
=> From_Project_Node
,
859 Extended_By
=> No_Project
);
861 if Project
/= No_Project
then
862 Check
(Project
, Process_Languages
, Follow_Links
);
865 -- If main project is an extending all project, set the object
866 -- directory of all virtual extending projects to the object directory
867 -- of the main project.
869 if Project
/= No_Project
870 and then Is_Extending_All
(From_Project_Node
)
873 Object_Dir
: constant Name_Id
:=
874 Projects
.Table
(Project
).Object_Directory
;
876 for Index
in Projects
.First
.. Projects
.Last
loop
877 if Projects
.Table
(Index
).Virtual
then
878 Projects
.Table
(Index
).Object_Directory
:= Object_Dir
;
884 -- Check that no extending project shares its object directory with
885 -- the project(s) it extends.
887 if Project
/= No_Project
then
888 for Proj
in 1 .. Projects
.Last
loop
889 Extending
:= Projects
.Table
(Proj
).Extended_By
;
891 if Extending
/= No_Project
then
892 Obj_Dir
:= Projects
.Table
(Proj
).Object_Directory
;
894 -- Check that a project being extended does not share its
895 -- object directory with any project that extends it, directly
896 -- or indirectly, including a virtual extending project.
898 -- Start with the project directly extending it
900 Extending2
:= Extending
;
902 while Extending2
/= No_Project
loop
903 if ((Process_Languages
= Ada_Language
905 Projects
.Table
(Extending2
).Ada_Sources_Present
)
907 (Process_Languages
= Other_Languages
909 Projects
.Table
(Extending2
).Other_Sources_Present
))
911 Projects
.Table
(Extending2
).Object_Directory
= Obj_Dir
913 if Projects
.Table
(Extending2
).Virtual
then
914 Error_Msg_Name_1
:= Projects
.Table
(Proj
).Name
;
916 if Error_Report
= null then
918 ("project % cannot be extended by a virtual " &
919 "project with the same object directory",
920 Projects
.Table
(Proj
).Location
);
925 Get_Name_String
(Error_Msg_Name_1
) &
926 """ cannot be extended by a virtual " &
927 "project with the same object directory",
933 Projects
.Table
(Extending2
).Name
;
934 Error_Msg_Name_2
:= Projects
.Table
(Proj
).Name
;
936 if Error_Report
= null then
938 ("project % cannot extend project %",
939 Projects
.Table
(Extending2
).Location
);
941 ("\they share the same object directory",
942 Projects
.Table
(Extending2
).Location
);
947 Get_Name_String
(Error_Msg_Name_1
) &
948 """ cannot extend project """ &
949 Get_Name_String
(Error_Msg_Name_2
) & """",
952 ("they share the same object directory",
958 -- Continue with the next extending project, if any
960 Extending2
:= Projects
.Table
(Extending2
).Extended_By
;
966 Success
:= Total_Errors_Detected
<= 0;
969 -------------------------------
970 -- Process_Declarative_Items --
971 -------------------------------
973 procedure Process_Declarative_Items
974 (Project
: Project_Id
;
975 From_Project_Node
: Project_Node_Id
;
977 Item
: Project_Node_Id
)
979 Current_Declarative_Item
: Project_Node_Id
:= Item
;
980 Current_Item
: Project_Node_Id
:= Empty_Node
;
983 -- For each declarative item
985 while Current_Declarative_Item
/= Empty_Node
loop
989 Current_Item
:= Current_Item_Node
(Current_Declarative_Item
);
991 -- And set Current_Declarative_Item to the next declarative item
992 -- ready for the next iteration.
994 Current_Declarative_Item
:= Next_Declarative_Item
995 (Current_Declarative_Item
);
997 case Kind_Of
(Current_Item
) is
999 when N_Package_Declaration
=>
1000 -- Do not process a package declaration that should be ignored
1002 if Expression_Kind_Of
(Current_Item
) /= Ignored
then
1003 -- Create the new package
1005 Packages
.Increment_Last
;
1008 New_Pkg
: constant Package_Id
:= Packages
.Last
;
1009 The_New_Package
: Package_Element
;
1011 Project_Of_Renamed_Package
: constant Project_Node_Id
:=
1012 Project_Of_Renamed_Package_Of
1016 -- Set the name of the new package
1018 The_New_Package
.Name
:= Name_Of
(Current_Item
);
1020 -- Insert the new package in the appropriate list
1022 if Pkg
/= No_Package
then
1023 The_New_Package
.Next
:=
1024 Packages
.Table
(Pkg
).Decl
.Packages
;
1025 Packages
.Table
(Pkg
).Decl
.Packages
:= New_Pkg
;
1027 The_New_Package
.Next
:=
1028 Projects
.Table
(Project
).Decl
.Packages
;
1029 Projects
.Table
(Project
).Decl
.Packages
:= New_Pkg
;
1032 Packages
.Table
(New_Pkg
) := The_New_Package
;
1034 if Project_Of_Renamed_Package
/= Empty_Node
then
1039 Project_Name
: constant Name_Id
:=
1041 (Project_Of_Renamed_Package
);
1043 Renamed_Project
: constant Project_Id
:=
1044 Imported_Or_Extended_Project_From
1045 (Project
, Project_Name
);
1047 Renamed_Package
: constant Package_Id
:=
1050 Name_Of
(Current_Item
));
1053 -- For a renamed package, set declarations to
1054 -- the declarations of the renamed package.
1056 Packages
.Table
(New_Pkg
).Decl
:=
1057 Packages
.Table
(Renamed_Package
).Decl
;
1060 -- Standard package declaration, not renaming
1063 -- Set the default values of the attributes
1067 Packages
.Table
(New_Pkg
).Decl
,
1069 (Package_Id_Of
(Current_Item
)));
1071 -- And process declarative items of the new package
1073 Process_Declarative_Items
1074 (Project
=> Project
,
1075 From_Project_Node
=> From_Project_Node
,
1077 Item
=> First_Declarative_Item_Of
1083 when N_String_Type_Declaration
=>
1085 -- There is nothing to process
1089 when N_Attribute_Declaration |
1090 N_Typed_Variable_Declaration |
1091 N_Variable_Declaration
=>
1093 if Expression_Of
(Current_Item
) = Empty_Node
then
1095 -- It must be a full associative array attribute declaration
1098 Current_Item_Name
: constant Name_Id
:=
1099 Name_Of
(Current_Item
);
1100 -- The name of the attribute
1102 New_Array
: Array_Id
;
1103 -- The new associative array created
1105 Orig_Array
: Array_Id
;
1106 -- The associative array value
1108 Orig_Project_Name
: Name_Id
:= No_Name
;
1109 -- The name of the project where the associative array
1112 Orig_Project
: Project_Id
:= No_Project
;
1113 -- The id of the project where the associative array
1116 Orig_Package_Name
: Name_Id
:= No_Name
;
1117 -- The name of the package, if any, where the associative
1120 Orig_Package
: Package_Id
:= No_Package
;
1121 -- The id of the package, if any, where the associative
1124 New_Element
: Array_Element_Id
:= No_Array_Element
;
1125 -- Id of a new array element created
1127 Prev_Element
: Array_Element_Id
:= No_Array_Element
;
1128 -- Last new element id created
1130 Orig_Element
: Array_Element_Id
:= No_Array_Element
;
1131 -- Current array element in the original associative
1134 Next_Element
: Array_Element_Id
:= No_Array_Element
;
1135 -- Id of the array element that follows the new element.
1136 -- This is not always nil, because values for the
1137 -- associative array attribute may already have been
1138 -- declared, and the array elements declared are reused.
1141 -- First, find if the associative array attribute already
1142 -- has elements declared.
1144 if Pkg
/= No_Package
then
1145 New_Array
:= Packages
.Table
(Pkg
).Decl
.Arrays
;
1148 New_Array
:= Projects
.Table
(Project
).Decl
.Arrays
;
1151 while New_Array
/= No_Array
and then
1152 Arrays
.Table
(New_Array
).Name
/= Current_Item_Name
1154 New_Array
:= Arrays
.Table
(New_Array
).Next
;
1157 -- If the attribute has never been declared add new entry
1158 -- in the arrays of the project/package and link it.
1160 if New_Array
= No_Array
then
1161 Arrays
.Increment_Last
;
1162 New_Array
:= Arrays
.Last
;
1164 if Pkg
/= No_Package
then
1165 Arrays
.Table
(New_Array
) :=
1166 (Name
=> Current_Item_Name
,
1167 Value
=> No_Array_Element
,
1168 Next
=> Packages
.Table
(Pkg
).Decl
.Arrays
);
1169 Packages
.Table
(Pkg
).Decl
.Arrays
:= New_Array
;
1172 Arrays
.Table
(New_Array
) :=
1173 (Name
=> Current_Item_Name
,
1174 Value
=> No_Array_Element
,
1175 Next
=> Projects
.Table
(Project
).Decl
.Arrays
);
1176 Projects
.Table
(Project
).Decl
.Arrays
:= New_Array
;
1180 -- Find the project where the value is declared
1182 Orig_Project_Name
:=
1183 Name_Of
(Associative_Project_Of
(Current_Item
));
1185 for Index
in Projects
.First
.. Projects
.Last
loop
1186 if Projects
.Table
(Index
).Name
= Orig_Project_Name
then
1187 Orig_Project
:= Index
;
1192 pragma Assert
(Orig_Project
/= No_Project
,
1193 "original project not found");
1195 if Associative_Package_Of
(Current_Item
) = Empty_Node
then
1197 Projects
.Table
(Orig_Project
).Decl
.Arrays
;
1200 -- If in a package, find the package where the
1201 -- value is declared.
1203 Orig_Package_Name
:=
1204 Name_Of
(Associative_Package_Of
(Current_Item
));
1206 Projects
.Table
(Orig_Project
).Decl
.Packages
;
1207 pragma Assert
(Orig_Package
/= No_Package
,
1208 "original package not found");
1210 while Packages
.Table
(Orig_Package
).Name
/=
1213 Orig_Package
:= Packages
.Table
(Orig_Package
).Next
;
1214 pragma Assert
(Orig_Package
/= No_Package
,
1215 "original package not found");
1219 Packages
.Table
(Orig_Package
).Decl
.Arrays
;
1222 -- Now look for the array
1224 while Orig_Array
/= No_Array
and then
1225 Arrays
.Table
(Orig_Array
).Name
/= Current_Item_Name
1227 Orig_Array
:= Arrays
.Table
(Orig_Array
).Next
;
1230 if Orig_Array
= No_Array
then
1231 if Error_Report
= null then
1233 ("associative array value cannot be found",
1234 Location_Of
(Current_Item
));
1238 ("associative array value cannot be found",
1243 Orig_Element
:= Arrays
.Table
(Orig_Array
).Value
;
1245 -- Copy each array element
1247 while Orig_Element
/= No_Array_Element
loop
1248 -- If it is the first element ...
1250 if Prev_Element
= No_Array_Element
then
1251 -- And there is no array element declared yet,
1252 -- create a new first array element.
1254 if Arrays
.Table
(New_Array
).Value
=
1257 Array_Elements
.Increment_Last
;
1258 New_Element
:= Array_Elements
.Last
;
1259 Arrays
.Table
(New_Array
).Value
:= New_Element
;
1260 Next_Element
:= No_Array_Element
;
1262 -- Otherwise, the new element is the first
1265 New_Element
:= Arrays
.Table
(New_Array
).Value
;
1267 Array_Elements
.Table
(New_Element
).Next
;
1270 -- Otherwise, reuse an existing element, or create
1271 -- one if necessary.
1275 Array_Elements
.Table
(Prev_Element
).Next
;
1277 if Next_Element
= No_Array_Element
then
1278 Array_Elements
.Increment_Last
;
1279 New_Element
:= Array_Elements
.Last
;
1282 New_Element
:= Next_Element
;
1284 Array_Elements
.Table
(New_Element
).Next
;
1288 -- Copy the value of the element
1290 Array_Elements
.Table
(New_Element
) :=
1291 Array_Elements
.Table
(Orig_Element
);
1292 Array_Elements
.Table
(New_Element
).Value
.Project
:=
1295 -- Adjust the Next link
1297 Array_Elements
.Table
(New_Element
).Next
:=
1300 -- Adjust the previous id for the next element
1302 Prev_Element
:= New_Element
;
1304 -- Go to the next element in the original array
1306 Array_Elements
.Table
(Orig_Element
).Next
;
1309 -- Make sure that the array ends here, in case there
1310 -- previously a greater number of elements.
1312 Array_Elements
.Table
(New_Element
).Next
:=
1317 -- Declarations other that full associative arrays
1321 New_Value
: constant Variable_Value
:=
1323 (Project
=> Project
,
1324 From_Project_Node
=> From_Project_Node
,
1327 Tree
.First_Term
(Expression_Of
1330 Expression_Kind_Of
(Current_Item
));
1331 -- The expression value
1333 The_Variable
: Variable_Id
:= No_Variable
;
1335 Current_Item_Name
: constant Name_Id
:=
1336 Name_Of
(Current_Item
);
1339 -- Process a typed variable declaration
1342 Kind_Of
(Current_Item
) = N_Typed_Variable_Declaration
1344 -- Report an error for an empty string
1346 if New_Value
.Value
= Empty_String
then
1347 Error_Msg_Name_1
:= Name_Of
(Current_Item
);
1349 if Error_Report
= null then
1351 ("no value defined for %",
1352 Location_Of
(Current_Item
));
1356 ("no value defined for " &
1357 Get_Name_String
(Error_Msg_Name_1
),
1363 Current_String
: Project_Node_Id
:=
1364 First_Literal_String
1369 -- Loop through all the valid strings for
1370 -- the string type and compare to the string
1373 while Current_String
/= Empty_Node
1374 and then String_Value_Of
(Current_String
) /=
1378 Next_Literal_String
(Current_String
);
1381 -- Report an error if the string value is not
1382 -- one for the string type.
1384 if Current_String
= Empty_Node
then
1385 Error_Msg_Name_1
:= New_Value
.Value
;
1386 Error_Msg_Name_2
:= Name_Of
(Current_Item
);
1388 if Error_Report
= null then
1390 ("value { is illegal for typed string %",
1391 Location_Of
(Current_Item
));
1396 Get_Name_String
(Error_Msg_Name_1
) &
1397 """ is illegal for typed string """ &
1398 Get_Name_String
(Error_Msg_Name_2
) &
1407 if Kind_Of
(Current_Item
) /= N_Attribute_Declaration
1409 Associative_Array_Index_Of
(Current_Item
) = No_Name
1411 -- Case of a variable declaration or of a not
1412 -- associative array attribute.
1414 -- First, find the list where to find the variable
1418 Kind_Of
(Current_Item
) = N_Attribute_Declaration
1420 if Pkg
/= No_Package
then
1422 Packages
.Table
(Pkg
).Decl
.Attributes
;
1426 Projects
.Table
(Project
).Decl
.Attributes
;
1430 if Pkg
/= No_Package
then
1432 Packages
.Table
(Pkg
).Decl
.Variables
;
1436 Projects
.Table
(Project
).Decl
.Variables
;
1441 -- Loop through the list, to find if it has already
1445 The_Variable
/= No_Variable
1447 Variable_Elements
.Table
(The_Variable
).Name
/=
1451 Variable_Elements
.Table
(The_Variable
).Next
;
1454 -- If it has not been declared, create a new entry
1457 if The_Variable
= No_Variable
then
1458 -- All single string attribute should already have
1459 -- been declared with a default empty string value.
1462 (Kind_Of
(Current_Item
) /=
1463 N_Attribute_Declaration
,
1464 "illegal attribute declaration");
1466 Variable_Elements
.Increment_Last
;
1467 The_Variable
:= Variable_Elements
.Last
;
1469 -- Put the new variable in the appropriate list
1471 if Pkg
/= No_Package
then
1472 Variable_Elements
.Table
(The_Variable
) :=
1474 Packages
.Table
(Pkg
).Decl
.Variables
,
1475 Name
=> Current_Item_Name
,
1476 Value
=> New_Value
);
1477 Packages
.Table
(Pkg
).Decl
.Variables
:=
1481 Variable_Elements
.Table
(The_Variable
) :=
1483 Projects
.Table
(Project
).Decl
.Variables
,
1484 Name
=> Current_Item_Name
,
1485 Value
=> New_Value
);
1486 Projects
.Table
(Project
).Decl
.Variables
:=
1490 -- If the variable/attribute has already been
1491 -- declared, just change the value.
1494 Variable_Elements
.Table
(The_Variable
).Value
:=
1500 -- Associative array attribute
1502 -- Get the string index
1505 (Associative_Array_Index_Of
(Current_Item
));
1507 -- Put in lower case, if necessary
1509 if Case_Insensitive
(Current_Item
) then
1510 GNAT
.Case_Util
.To_Lower
1511 (Name_Buffer
(1 .. Name_Len
));
1515 The_Array
: Array_Id
;
1517 The_Array_Element
: Array_Element_Id
:=
1520 Index_Name
: constant Name_Id
:= Name_Find
;
1521 -- The name id of the index
1524 -- Look for the array in the appropriate list
1526 if Pkg
/= No_Package
then
1527 The_Array
:= Packages
.Table
(Pkg
).Decl
.Arrays
;
1530 The_Array
:= Projects
.Table
1531 (Project
).Decl
.Arrays
;
1535 The_Array
/= No_Array
1536 and then Arrays
.Table
(The_Array
).Name
/=
1539 The_Array
:= Arrays
.Table
(The_Array
).Next
;
1542 -- If the array cannot be found, create a new
1543 -- entry in the list. As The_Array_Element is
1544 -- initialized to No_Array_Element, a new element
1545 -- will be created automatically later.
1547 if The_Array
= No_Array
then
1548 Arrays
.Increment_Last
;
1549 The_Array
:= Arrays
.Last
;
1551 if Pkg
/= No_Package
then
1552 Arrays
.Table
(The_Array
) :=
1553 (Name
=> Current_Item_Name
,
1554 Value
=> No_Array_Element
,
1555 Next
=> Packages
.Table
(Pkg
).Decl
.Arrays
);
1556 Packages
.Table
(Pkg
).Decl
.Arrays
:= The_Array
;
1559 Arrays
.Table
(The_Array
) :=
1560 (Name
=> Current_Item_Name
,
1561 Value
=> No_Array_Element
,
1563 Projects
.Table
(Project
).Decl
.Arrays
);
1564 Projects
.Table
(Project
).Decl
.Arrays
:=
1568 -- Otherwise, initialize The_Array_Element as the
1569 -- head of the element list.
1572 The_Array_Element
:=
1573 Arrays
.Table
(The_Array
).Value
;
1576 -- Look in the list, if any, to find an element
1577 -- with the same index.
1579 while The_Array_Element
/= No_Array_Element
1581 Array_Elements
.Table
(The_Array_Element
).Index
/=
1584 The_Array_Element
:=
1585 Array_Elements
.Table
(The_Array_Element
).Next
;
1588 -- If no such element were found, create a new
1589 -- one and insert it in the element list, with
1590 -- the propoer value.
1592 if The_Array_Element
= No_Array_Element
then
1593 Array_Elements
.Increment_Last
;
1594 The_Array_Element
:= Array_Elements
.Last
;
1596 Array_Elements
.Table
(The_Array_Element
) :=
1597 (Index
=> Index_Name
,
1598 Src_Index
=> Source_Index_Of
(Current_Item
),
1599 Index_Case_Sensitive
=>
1600 not Case_Insensitive
(Current_Item
),
1602 Next
=> Arrays
.Table
(The_Array
).Value
);
1603 Arrays
.Table
(The_Array
).Value
:=
1606 -- An element with the same index already exists,
1607 -- just replace its value with the new one.
1610 Array_Elements
.Table
(The_Array_Element
).Value
:=
1618 when N_Case_Construction
=>
1620 The_Project
: Project_Id
:= Project
;
1621 -- The id of the project of the case variable
1623 The_Package
: Package_Id
:= Pkg
;
1624 -- The id of the package, if any, of the case variable
1626 The_Variable
: Variable_Value
:= Nil_Variable_Value
;
1627 -- The case variable
1629 Case_Value
: Name_Id
:= No_Name
;
1630 -- The case variable value
1632 Case_Item
: Project_Node_Id
:= Empty_Node
;
1633 Choice_String
: Project_Node_Id
:= Empty_Node
;
1634 Decl_Item
: Project_Node_Id
:= Empty_Node
;
1638 Variable_Node
: constant Project_Node_Id
:=
1639 Case_Variable_Reference_Of
1642 Var_Id
: Variable_Id
:= No_Variable
;
1643 Name
: Name_Id
:= No_Name
;
1646 -- If a project were specified for the case variable,
1649 if Project_Node_Of
(Variable_Node
) /= Empty_Node
then
1650 Name
:= Name_Of
(Project_Node_Of
(Variable_Node
));
1652 Imported_Or_Extended_Project_From
(Project
, Name
);
1655 -- If a package were specified for the case variable,
1658 if Package_Node_Of
(Variable_Node
) /= Empty_Node
then
1659 Name
:= Name_Of
(Package_Node_Of
(Variable_Node
));
1660 The_Package
:= Package_From
(The_Project
, Name
);
1663 Name
:= Name_Of
(Variable_Node
);
1665 -- First, look for the case variable into the package,
1668 if The_Package
/= No_Package
then
1669 Var_Id
:= Packages
.Table
(The_Package
).Decl
.Variables
;
1670 Name
:= Name_Of
(Variable_Node
);
1671 while Var_Id
/= No_Variable
1673 Variable_Elements
.Table
(Var_Id
).Name
/= Name
1675 Var_Id
:= Variable_Elements
.Table
(Var_Id
).Next
;
1679 -- If not found in the package, or if there is no
1680 -- package, look at the project level.
1682 if Var_Id
= No_Variable
1683 and then Package_Node_Of
(Variable_Node
) = Empty_Node
1685 Var_Id
:= Projects
.Table
(The_Project
).Decl
.Variables
;
1686 while Var_Id
/= No_Variable
1688 Variable_Elements
.Table
(Var_Id
).Name
/= Name
1690 Var_Id
:= Variable_Elements
.Table
(Var_Id
).Next
;
1694 if Var_Id
= No_Variable
then
1696 -- Should never happen, because this has already been
1697 -- checked during parsing.
1699 Write_Line
("variable """ &
1700 Get_Name_String
(Name
) &
1702 raise Program_Error
;
1705 -- Get the case variable
1707 The_Variable
:= Variable_Elements
.Table
(Var_Id
).Value
;
1709 if The_Variable
.Kind
/= Single
then
1711 -- Should never happen, because this has already been
1712 -- checked during parsing.
1714 Write_Line
("variable""" &
1715 Get_Name_String
(Name
) &
1716 """ is not a single string variable");
1717 raise Program_Error
;
1720 -- Get the case variable value
1721 Case_Value
:= The_Variable
.Value
;
1724 -- Now look into all the case items of the case construction
1726 Case_Item
:= First_Case_Item_Of
(Current_Item
);
1728 while Case_Item
/= Empty_Node
loop
1729 Choice_String
:= First_Choice_Of
(Case_Item
);
1731 -- When Choice_String is nil, it means that it is
1732 -- the "when others =>" alternative.
1734 if Choice_String
= Empty_Node
then
1735 Decl_Item
:= First_Declarative_Item_Of
(Case_Item
);
1736 exit Case_Item_Loop
;
1739 -- Look into all the alternative of this case item
1742 while Choice_String
/= Empty_Node
loop
1744 Case_Value
= String_Value_Of
(Choice_String
)
1747 First_Declarative_Item_Of
(Case_Item
);
1748 exit Case_Item_Loop
;
1752 Next_Literal_String
(Choice_String
);
1753 end loop Choice_Loop
;
1754 Case_Item
:= Next_Case_Item
(Case_Item
);
1755 end loop Case_Item_Loop
;
1757 -- If there is an alternative, then we process it
1759 if Decl_Item
/= Empty_Node
then
1760 Process_Declarative_Items
1761 (Project
=> Project
,
1762 From_Project_Node
=> From_Project_Node
,
1770 -- Should never happen
1772 Write_Line
("Illegal declarative item: " &
1773 Project_Node_Kind
'Image (Kind_Of
(Current_Item
)));
1774 raise Program_Error
;
1777 end Process_Declarative_Items
;
1779 ---------------------
1780 -- Recursive_Check --
1781 ---------------------
1783 procedure Recursive_Check
1784 (Project
: Project_Id
;
1785 Process_Languages
: Languages_Processed
;
1786 Follow_Links
: Boolean)
1788 Data
: Project_Data
;
1789 Imported_Project_List
: Project_List
:= Empty_Project_List
;
1792 -- Do nothing if Project is No_Project, or Project has already
1793 -- been marked as checked.
1795 if Project
/= No_Project
1796 and then not Projects
.Table
(Project
).Checked
1798 -- Mark project as checked, to avoid infinite recursion in
1799 -- ill-formed trees, where a project imports itself.
1801 Projects
.Table
(Project
).Checked
:= True;
1803 Data
:= Projects
.Table
(Project
);
1805 -- Call itself for a possible extended project.
1806 -- (if there is no extended project, then nothing happens).
1808 Recursive_Check
(Data
.Extends
, Process_Languages
, Follow_Links
);
1810 -- Call itself for all imported projects
1812 Imported_Project_List
:= Data
.Imported_Projects
;
1813 while Imported_Project_List
/= Empty_Project_List
loop
1815 (Project_Lists
.Table
(Imported_Project_List
).Project
,
1816 Process_Languages
, Follow_Links
);
1817 Imported_Project_List
:=
1818 Project_Lists
.Table
(Imported_Project_List
).Next
;
1821 if Opt
.Verbose_Mode
then
1822 Write_Str
("Checking project file """);
1823 Write_Str
(Get_Name_String
(Data
.Name
));
1827 case Process_Languages
is
1828 when Ada_Language
=>
1829 Prj
.Nmsc
.Ada_Check
(Project
, Error_Report
, Follow_Links
);
1831 when Other_Languages
=>
1832 Prj
.Nmsc
.Other_Languages_Check
(Project
, Error_Report
);
1834 when All_Languages
=>
1835 Prj
.Nmsc
.Ada_Check
(Project
, Error_Report
, Follow_Links
);
1836 Prj
.Nmsc
.Other_Languages_Check
(Project
, Error_Report
);
1840 end Recursive_Check
;
1842 -----------------------
1843 -- Recursive_Process --
1844 -----------------------
1846 procedure Recursive_Process
1847 (Project
: out Project_Id
;
1848 From_Project_Node
: Project_Node_Id
;
1849 Extended_By
: Project_Id
)
1851 With_Clause
: Project_Node_Id
;
1854 if From_Project_Node
= Empty_Node
then
1855 Project
:= No_Project
;
1859 Processed_Data
: Project_Data
:= Empty_Project
;
1860 Imported
: Project_List
:= Empty_Project_List
;
1861 Declaration_Node
: Project_Node_Id
:= Empty_Node
;
1862 Name
: constant Name_Id
:= Name_Of
(From_Project_Node
);
1865 Project
:= Processed_Projects
.Get
(Name
);
1867 if Project
/= No_Project
then
1871 Projects
.Increment_Last
;
1872 Project
:= Projects
.Last
;
1873 Processed_Projects
.Set
(Name
, Project
);
1875 Processed_Data
.Name
:= Name
;
1877 Get_Name_String
(Name
);
1879 -- If name starts with the virtual prefix, flag the project as
1880 -- being a virtual extending project.
1882 if Name_Len
> Virtual_Prefix
'Length
1883 and then Name_Buffer
(1 .. Virtual_Prefix
'Length) =
1886 Processed_Data
.Virtual
:= True;
1889 Processed_Data
.Display_Path_Name
:=
1890 Path_Name_Of
(From_Project_Node
);
1891 Get_Name_String
(Processed_Data
.Display_Path_Name
);
1892 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
1893 Processed_Data
.Path_Name
:= Name_Find
;
1895 Processed_Data
.Location
:= Location_Of
(From_Project_Node
);
1897 Processed_Data
.Display_Directory
:=
1898 Directory_Of
(From_Project_Node
);
1899 Get_Name_String
(Processed_Data
.Display_Directory
);
1900 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
1901 Processed_Data
.Directory
:= Name_Find
;
1903 Processed_Data
.Extended_By
:= Extended_By
;
1904 Processed_Data
.Naming
:= Standard_Naming_Data
;
1906 Add_Attributes
(Project
, Processed_Data
.Decl
, Attribute_First
);
1907 With_Clause
:= First_With_Clause_Of
(From_Project_Node
);
1909 while With_Clause
/= Empty_Node
loop
1911 New_Project
: Project_Id
;
1912 New_Data
: Project_Data
;
1916 (Project
=> New_Project
,
1917 From_Project_Node
=> Project_Node_Of
(With_Clause
),
1918 Extended_By
=> No_Project
);
1919 New_Data
:= Projects
.Table
(New_Project
);
1921 -- If we were the first project to import it,
1922 -- set First_Referred_By to us.
1924 if New_Data
.First_Referred_By
= No_Project
then
1925 New_Data
.First_Referred_By
:= Project
;
1926 Projects
.Table
(New_Project
) := New_Data
;
1929 -- Add this project to our list of imported projects
1931 Project_Lists
.Increment_Last
;
1932 Project_Lists
.Table
(Project_Lists
.Last
) :=
1933 (Project
=> New_Project
, Next
=> Empty_Project_List
);
1935 -- Imported is the id of the last imported project.
1936 -- If it is nil, then this imported project is our first.
1938 if Imported
= Empty_Project_List
then
1939 Processed_Data
.Imported_Projects
:= Project_Lists
.Last
;
1942 Project_Lists
.Table
(Imported
).Next
:= Project_Lists
.Last
;
1945 Imported
:= Project_Lists
.Last
;
1947 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
1951 Declaration_Node
:= Project_Declaration_Of
(From_Project_Node
);
1954 (Project
=> Processed_Data
.Extends
,
1955 From_Project_Node
=> Extended_Project_Of
(Declaration_Node
),
1956 Extended_By
=> Project
);
1958 Projects
.Table
(Project
) := Processed_Data
;
1960 Process_Declarative_Items
1961 (Project
=> Project
,
1962 From_Project_Node
=> From_Project_Node
,
1964 Item
=> First_Declarative_Item_Of
1965 (Declaration_Node
));
1967 -- If it is an extending project, inherit all packages
1968 -- from the extended project that are not explicitely defined
1969 -- or renamed. Also inherit the languages, if attribute Languages
1970 -- is not explicitely defined.
1972 if Processed_Data
.Extends
/= No_Project
then
1973 Processed_Data
:= Projects
.Table
(Project
);
1976 Extended_Pkg
: Package_Id
:=
1978 (Processed_Data
.Extends
).Decl
.Packages
;
1979 Current_Pkg
: Package_Id
;
1980 Element
: Package_Element
;
1981 First
: constant Package_Id
:=
1982 Processed_Data
.Decl
.Packages
;
1983 Attribute1
: Variable_Id
;
1984 Attribute2
: Variable_Id
;
1985 Attr_Value1
: Variable
;
1986 Attr_Value2
: Variable
;
1989 while Extended_Pkg
/= No_Package
loop
1990 Element
:= Packages
.Table
(Extended_Pkg
);
1992 Current_Pkg
:= First
;
1995 exit when Current_Pkg
= No_Package
1996 or else Packages
.Table
(Current_Pkg
).Name
1998 Current_Pkg
:= Packages
.Table
(Current_Pkg
).Next
;
2001 if Current_Pkg
= No_Package
then
2002 Packages
.Increment_Last
;
2003 Current_Pkg
:= Packages
.Last
;
2004 Packages
.Table
(Current_Pkg
) :=
2005 (Name
=> Element
.Name
,
2006 Decl
=> Element
.Decl
,
2007 Parent
=> No_Package
,
2008 Next
=> Processed_Data
.Decl
.Packages
);
2009 Processed_Data
.Decl
.Packages
:= Current_Pkg
;
2012 Extended_Pkg
:= Element
.Next
;
2015 -- Check if attribute Languages is declared in the
2016 -- extending project.
2018 Attribute1
:= Processed_Data
.Decl
.Attributes
;
2019 while Attribute1
/= No_Variable
loop
2020 Attr_Value1
:= Variable_Elements
.Table
(Attribute1
);
2021 exit when Attr_Value1
.Name
= Snames
.Name_Languages
;
2022 Attribute1
:= Attr_Value1
.Next
;
2025 if Attribute1
= No_Variable
or else
2026 Attr_Value1
.Value
.Default
2028 -- Attribute Languages is not declared in the extending
2029 -- project. Check if it is declared in the project being
2033 Projects
.Table
(Processed_Data
.Extends
).Decl
.Attributes
;
2035 while Attribute2
/= No_Variable
loop
2036 Attr_Value2
:= Variable_Elements
.Table
(Attribute2
);
2037 exit when Attr_Value2
.Name
= Snames
.Name_Languages
;
2038 Attribute2
:= Attr_Value2
.Next
;
2041 if Attribute2
/= No_Variable
and then
2042 not Attr_Value2
.Value
.Default
2044 -- As attribute Languages is declared in the project
2045 -- being extended, copy its value for the extending
2048 if Attribute1
= No_Variable
then
2049 Variable_Elements
.Increment_Last
;
2050 Attribute1
:= Variable_Elements
.Last
;
2051 Attr_Value1
.Next
:= Processed_Data
.Decl
.Attributes
;
2052 Processed_Data
.Decl
.Attributes
:= Attribute1
;
2055 Attr_Value1
.Name
:= Snames
.Name_Languages
;
2056 Attr_Value1
.Value
:= Attr_Value2
.Value
;
2057 Variable_Elements
.Table
(Attribute1
) := Attr_Value1
;
2062 Projects
.Table
(Project
) := Processed_Data
;
2066 end Recursive_Process
;