In_Tree : Project_Tree_Ref;
Data : in out Project_Data)
is
- Compiler_Pkg : constant Package_Id :=
- Value_Of (Name_Compiler, Data.Decl.Packages, In_Tree);
- Binder_Pkg : constant Package_Id :=
- Value_Of (Name_Binder, Data.Decl.Packages, In_Tree);
- Element : Package_Element;
+ Dot_Replacement : File_Name_Type := No_File;
+ Casing : Casing_Type := All_Lower_Case;
+ Separate_Suffix : File_Name_Type := No_File;
- Arrays : Array_Id;
- Current_Array : Array_Data;
- Arr_Elmt_Id : Array_Element_Id;
- Arr_Element : Array_Element;
- List : String_List_Id;
+ Lang_Index : Language_Index := No_Language_Index;
+ -- The index of the language data being checked
- Current_Language_Index : Language_Index;
+ Current_Language : Name_Id := No_Name;
+ -- The name of the language
- procedure Get_Language (Name : Name_Id);
- -- Check if this is the name of a language of the project and
- -- set Current_Language_Index accordingly.
+ Lang_Data : Language_Data;
+ -- The data of the language being checked
- ------------------
- -- Get_Language --
- ------------------
+ procedure Get_Language_Index_Of (Language : Name_Id);
+ -- Get the language index of Language, if Language is one of the
+ -- languages of the project.
- procedure Get_Language (Name : Name_Id) is
+ procedure Process_Project_Level_Simple_Attributes;
+ -- Process the simple attributes at the project level
+
+ procedure Process_Project_Level_Array_Attributes;
+ -- Process the associate array attributes at the project level
+
+ procedure Process_Packages;
+ -- Read the packages of the project
+
+ ---------------------------
+ -- Get_Language_Index_Of --
+ ---------------------------
+
+ procedure Get_Language_Index_Of (Language : Name_Id) is
Real_Language : Name_Id;
begin
- Get_Name_String (Name);
+ Get_Name_String (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Real_Language := Name_Find;
- Current_Language_Index := Data.First_Language_Processing;
- loop
- exit when Current_Language_Index = No_Language_Index or else
- In_Tree.Languages_Data.Table (Current_Language_Index).Name =
- Real_Language;
- Current_Language_Index :=
- In_Tree.Languages_Data.Table (Current_Language_Index).Next;
- end loop;
- end Get_Language;
+ -- Nothing to do if the language is the same as the current language
- -- Start of processing for Check_Configuration
+ if Current_Language /= Real_Language then
+ Lang_Index := Data.First_Language_Processing;
+ while Lang_Index /= No_Language_Index loop
+ exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
+ Real_Language;
+ Lang_Index :=
+ In_Tree.Languages_Data.Table (Lang_Index).Next;
+ end loop;
- begin
- if Compiler_Pkg /= No_Package then
- Element := In_Tree.Packages.Table (Compiler_Pkg);
+ if Lang_Index = No_Language_Index then
+ Current_Language := No_Name;
+ else
+ Current_Language := Real_Language;
+ end if;
+ end if;
+ end Get_Language_Index_Of;
- Arrays := Element.Decl.Arrays;
- while Arrays /= No_Array loop
- Current_Array := In_Tree.Arrays.Table (Arrays);
+ ----------------------
+ -- Process_Packages --
+ ----------------------
- Arr_Elmt_Id := Current_Array.Value;
- while Arr_Elmt_Id /= No_Array_Element loop
- Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id);
- Get_Language (Arr_Element.Index);
+ procedure Process_Packages is
+ Packages : Package_Id;
+ Element : Package_Element;
- if Current_Language_Index /= No_Language_Index then
- case Current_Array.Name is
- when Name_Dependency_Switches =>
- List := Arr_Element.Value.Values;
+ procedure Process_Binder (Arrays : Array_Id);
+ -- Process the associate array attributes of package Binder
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "dependency option cannot be null",
- Arr_Element.Value.Location);
- end if;
+ procedure Process_Builder (Attributes : Variable_Id);
+ -- Process the simple attributes of package Builder
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Dependency_Option,
- From_List => List,
- In_Tree => In_Tree);
+ procedure Process_Compiler (Arrays : Array_Id);
+ -- Process the associate array attributes of package Compiler
- when Name_Dependency_Driver =>
+ procedure Process_Naming (Attributes : Variable_Id);
+ -- Process the simple attributes of package Naming
- -- Attribute Dependency_Driver (<language>)
+ procedure Process_Naming (Arrays : Array_Id);
+ -- Process the associate array attributes of package Naming
- List := Arr_Element.Value.Values;
+ procedure Process_Linker (Attributes : Variable_Id);
+ -- Process the simple attributes of package Linker of a
+ -- configuration project.
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "compute dependency cannot be null",
- Arr_Element.Value.Location);
- end if;
+ --------------------
+ -- Process_Binder --
+ --------------------
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Compute_Dependency,
- From_List => List,
- In_Tree => In_Tree);
+ procedure Process_Binder (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
- when Name_Include_Option =>
+ begin
+ -- Process the associative array attribute of package Binder
- -- Attribute Include_Option (<language>)
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
- List := Arr_Element.Value.Values;
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := In_Tree.Array_Elements.Table (Element_Id);
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "include option cannot be null",
- Arr_Element.Value.Location);
- end if;
+ -- Get the name of the language
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Include_Option,
- From_List => List,
- In_Tree => In_Tree);
+ Get_Language_Index_Of (Element.Index);
- when Name_Include_Path =>
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Driver =>
- -- Attribute Include_Path (<language>)
+ -- Attribute Driver (<language>)
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Include_Path :=
- Arr_Element.Value.Value;
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Binder_Driver :=
+ File_Name_Type (Element.Value.Value);
- when Name_Include_Path_File =>
+ when Name_Required_Switches =>
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Binder_Required_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => In_Tree);
- -- Attribute Include_Path_File (<language>)
+ when Name_Prefix =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Include_Path_File :=
- Arr_Element.Value.Value;
+ -- Attribute Prefix (<language>)
- when Name_Driver =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Binder_Prefix :=
+ Element.Value.Value;
- -- Attribute Driver (<language>)
+ when Name_Objects_Path =>
- Get_Name_String (Arr_Element.Value.Value);
+ -- Attribute Objects_Path (<language>)
- if Name_Len = 0 then
- Error_Msg
- (Project, In_Tree,
- "compiler driver name cannot be empty",
- Arr_Element.Value.Location);
- end if;
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Objects_Path :=
+ Element.Value.Value;
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Compiler_Driver :=
- File_Name_Type (Arr_Element.Value.Value);
+ when Name_Objects_Path_File =>
- when Name_Switches =>
+ -- Attribute Objects_Path (<language>)
- -- Attribute Minimum_Compiler_Options (<language>)
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Objects_Path_File :=
+ Element.Value.Value;
- List := Arr_Element.Value.Values;
+ when others =>
+ null;
+ end case;
+ end if;
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.
- Compiler_Min_Options,
- From_List => List,
- In_Tree => In_Tree);
+ Element_Id := Element.Next;
+ end loop;
- when Name_Pic_Option =>
+ Current_Array_Id := Current_Array.Next;
+ end loop;
+ end Process_Binder;
- -- Attribute Pic_Option (<language>)
+ ---------------------
+ -- Process_Builder --
+ ---------------------
- List := Arr_Element.Value.Values;
+ procedure Process_Builder (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "compiler PIC option cannot be null",
- Arr_Element.Value.Location);
- end if;
+ begin
+ -- Process non associated array attribute from package Builder
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.
- Compilation_PIC_Option,
- From_List => List,
- In_Tree => In_Tree);
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute :=
+ In_Tree.Variable_Elements.Table (Attribute_Id);
- when Name_Mapping_File_Switches =>
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Executable_Suffix then
- -- Attribute Mapping_File_Switches (<language>)
+ -- Attribute Executable_Suffix: the suffix of the
+ -- executables.
- List := Arr_Element.Value.Values;
+ Data.Config.Executable_Suffix :=
+ Attribute.Value.Value;
+ end if;
+ end if;
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "mapping file switches cannot be null",
- Arr_Element.Value.Location);
- end if;
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Builder;
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.
- Mapping_File_Switches,
- From_List => List,
- In_Tree => In_Tree);
+ ----------------------
+ -- Process_Compiler --
+ ----------------------
- when Name_Mapping_Spec_Suffix =>
+ procedure Process_Compiler (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+ List : String_List_Id;
- -- Attribute Mapping_Spec_Suffix (<language>)
+ begin
+ -- Process the associative array attribute of package Compiler
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Mapping_Spec_Suffix :=
- File_Name_Type (Arr_Element.Value.Value);
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
- when Name_Mapping_Body_Suffix =>
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := In_Tree.Array_Elements.Table (Element_Id);
- -- Attribute Mapping_Body_Suffix (<language>)
+ -- Get the name of the language
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Mapping_Body_Suffix :=
- File_Name_Type (Arr_Element.Value.Value);
+ Get_Language_Index_Of (Element.Index);
- when Name_Config_File_Switches =>
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Dependency_Switches =>
- -- Attribute Config_File_Switches (<language>)
+ -- Attribute Dependency_Switches (<language>)
- List := Arr_Element.Value.Values;
+ List := Element.Value.Values;
- if List = Nil_String then
- Error_Msg
- (Project, In_Tree,
- "config file switches cannot be null",
- Arr_Element.Value.Location);
- end if;
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "dependency option cannot be null",
+ Element.Value.Location);
+ end if;
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.
- Config_File_Switches,
- From_List => List,
- In_Tree => In_Tree);
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Option,
+ From_List => List,
+ In_Tree => In_Tree);
- when Name_Config_Body_File_Name =>
+ when Name_Dependency_Driver =>
- -- Attribute Config_Body_File_Name (<language>)
+ -- Attribute Dependency_Driver (<language>)
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Config_Body :=
- Arr_Element.Value.Value;
+ List := Element.Value.Values;
- when Name_Config_Body_File_Name_Pattern =>
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "compute dependency cannot be null",
+ Element.Value.Location);
+ end if;
- -- Attribute Config_Body_File_Name_Pattern
- -- (<language>)
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Compute_Dependency,
+ From_List => List,
+ In_Tree => In_Tree);
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Config_Body_Pattern :=
- Arr_Element.Value.Value;
+ when Name_Include_Switches =>
- when Name_Config_Spec_File_Name =>
+ -- Attribute Include_Switches (<language>)
- -- Attribute Config_Spec_File_Name (<language>)
+ List := Element.Value.Values;
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Config_Spec :=
- Arr_Element.Value.Value;
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "include option cannot be null",
+ Element.Value.Location);
+ end if;
- when Name_Config_Spec_File_Name_Pattern =>
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Include_Option,
+ From_List => List,
+ In_Tree => In_Tree);
- -- Attribute Config_Spec_File_Name_Pattern
- -- (<language>)
+ when Name_Include_Path =>
- In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Config_Spec_Pattern :=
- Arr_Element.Value.Value;
+ -- Attribute Include_Path (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Include_Path :=
+ Element.Value.Value;
- when Name_Config_File_Unique =>
+ when Name_Include_Path_File =>
- -- Attribute Config_File_Unique (<language>)
+ -- Attribute Include_Path_File (<language>)
- begin
In_Tree.Languages_Data.Table
- (Current_Language_Index)
- .Config.Config_File_Unique :=
- Boolean'Value
- (Get_Name_String (Arr_Element.Value.Value));
- exception
- when Constraint_Error =>
+ (Lang_Index).Config.Include_Path_File :=
+ Element.Value.Value;
+
+ when Name_Driver =>
+
+ -- Attribute Driver (<language>)
+
+ Get_Name_String (Element.Value.Value);
+
+ if Name_Len = 0 then
Error_Msg
- (Project, In_Tree,
- "illegal value gor Config_File_Unique",
- Arr_Element.Value.Location);
- end;
+ (Project,
+ In_Tree,
+ "compiler driver name cannot be empty",
+ Element.Value.Location);
+ end if;
- when others =>
- null;
- end case;
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Compiler_Driver :=
+ File_Name_Type (Element.Value.Value);
+
+ when Name_Required_Switches =>
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.
+ Compiler_Required_Switches,
+ From_List => Element.Value.Values,
+ In_Tree => In_Tree);
+
+ when Name_Pic_Option =>
+
+ -- Attribute Compiler_Pic_Option (<language>)
+
+ List := Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "compiler PIC option cannot be null",
+ Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Compilation_PIC_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Mapping_File_Switches =>
+
+ -- Attribute Mapping_File_Switches (<language>)
+
+ List := Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "mapping file switches cannot be null",
+ Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Mapping_File_Switches,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Mapping_Spec_Suffix =>
+
+ -- Attribute Mapping_Spec_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Mapping_Spec_Suffix :=
+ File_Name_Type (Element.Value.Value);
+
+ when Name_Mapping_Body_Suffix =>
+
+ -- Attribute Mapping_Body_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Mapping_Body_Suffix :=
+ File_Name_Type (Element.Value.Value);
+
+ when Name_Config_File_Switches =>
+
+ -- Attribute Config_File_Switches (<language>)
+
+ List := Element.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "config file switches cannot be null",
+ Element.Value.Location);
+ end if;
+
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_File_Switches,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ when Name_Objects_Path =>
+
+ -- Attribute Objects_Path (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Objects_Path :=
+ Element.Value.Value;
+
+ when Name_Objects_Path_File =>
+
+ -- Attribute Objects_Path_File (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Objects_Path_File :=
+ Element.Value.Value;
+
+ when Name_Config_Body_File_Name =>
+
+ -- Attribute Config_Body_File_Name (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_Body :=
+ Element.Value.Value;
+
+ when Name_Config_Body_File_Name_Pattern =>
+
+ -- Attribute Config_Body_File_Name_Pattern
+ -- (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_Body_Pattern :=
+ Element.Value.Value;
+
+ when Name_Config_Spec_File_Name =>
+
+ -- Attribute Config_Spec_File_Name (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_Spec :=
+ Element.Value.Value;
+
+ when Name_Config_Spec_File_Name_Pattern =>
+
+ -- Attribute Config_Spec_File_Name_Pattern
+ -- (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_Spec_Pattern :=
+ Element.Value.Value;
+
+ when Name_Config_File_Unique =>
+
+ -- Attribute Config_File_Unique (<language>)
+
+ begin
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_File_Unique :=
+ Boolean'Value
+ (Get_Name_String (Element.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "illegal value for Config_File_Unique",
+ Element.Value.Location);
+ end;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Element_Id := Element.Next;
+ end loop;
+
+ Current_Array_Id := Current_Array.Next;
+ end loop;
+ end Process_Compiler;
+
+ --------------------
+ -- Process_Naming --
+ --------------------
+
+ procedure Process_Naming (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
+
+ begin
+ -- Process non associated array attribute from package Naming
+
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute :=
+ In_Tree.Variable_Elements.Table (Attribute_Id);
+
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Separate_Suffix then
+
+ -- Attribute Separate_Suffix
+
+ Separate_Suffix := File_Name_Type (Attribute.Value.Value);
+
+ elsif Attribute.Name = Name_Casing then
+
+ -- Attribute Casing
+
+ begin
+ Casing :=
+ Value (Get_Name_String (Attribute.Value.Value));
+
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value for Casing",
+ Attribute.Value.Location);
+ end;
+
+ elsif Attribute.Name = Name_Dot_Replacement then
+
+ -- Attribute Dot_Replacement
+
+ Dot_Replacement := File_Name_Type (Attribute.Value.Value);
+
+ end if;
end if;
- Arr_Elmt_Id := Arr_Element.Next;
+ Attribute_Id := Attribute.Next;
end loop;
+ end Process_Naming;
+
+ procedure Process_Naming (Arrays : Array_Id) is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+ begin
+ -- Process the associative array attribute of package Naming
+
+ Current_Array_Id := Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
+
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := In_Tree.Array_Elements.Table (Element_Id);
+
+ -- Get the name of the language
+
+ Get_Language_Index_Of (Element.Index);
+
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Specification_Suffix | Name_Spec_Suffix =>
+
+ -- Attribute Spec_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Spec_Suffix :=
+ File_Name_Type (Element.Value.Value);
+
+ when Name_Implementation_Suffix | Name_Body_Suffix =>
+
+ -- Attribute Body_Suffix (<language>)
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Body_Suffix :=
+ File_Name_Type (Element.Value.Value);
+
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Separate_Suffix :=
+ File_Name_Type (Element.Value.Value);
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Element_Id := Element.Next;
+ end loop;
+
+ Current_Array_Id := Current_Array.Next;
+ end loop;
+ end Process_Naming;
+
+ --------------------
+ -- Process_Linker --
+ --------------------
+
+ procedure Process_Linker (Attributes : Variable_Id) is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
+
+ begin
+ -- Process non associated array attribute from package Linker
+
+ Attribute_Id := Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute :=
+ In_Tree.Variable_Elements.Table (Attribute_Id);
+
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Driver then
+
+ -- Attribute Linker'Driver: the default linker to use
+
+ Data.Config.Linker :=
+ Path_Name_Type (Attribute.Value.Value);
+
+ elsif
+ Attribute.Name = Name_Required_Switches
+ then
+
+ -- Attribute Required_Switches: the minimum
+ -- options to use when invoking the linker
+
+ Put (Into_List =>
+ Data.Config.Minimum_Linker_Options,
+ From_List => Attribute.Value.Values,
+ In_Tree => In_Tree);
+
+ end if;
+ end if;
+
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Linker;
+
+ -- Start of processing for Process_Packages
+
+ begin
+ Packages := Data.Decl.Packages;
+ while Packages /= No_Package loop
+ Element := In_Tree.Packages.Table (Packages);
+
+ case Element.Name is
+ when Name_Binder =>
+
+ -- Process attributes of package Binder
+
+ Process_Binder (Element.Decl.Arrays);
+
+ when Name_Builder =>
+
+ -- Process attributes of package Builder
+
+ Process_Builder (Element.Decl.Attributes);
+
+ when Name_Compiler =>
+
+ -- Process attributes of package Compiler
+
+ Process_Compiler (Element.Decl.Arrays);
+
+ when Name_Linker =>
+
+ -- Process attributes of package Linker
+
+ Process_Linker (Element.Decl.Attributes);
+
+ when Name_Naming =>
+
+ -- Process attributes of package Naming
+
+ Process_Naming (Element.Decl.Attributes);
+ Process_Naming (Element.Decl.Arrays);
+
+ when others =>
+ null;
+ end case;
- Arrays := Current_Array.Next;
+ Packages := Element.Next;
end loop;
- end if;
+ end Process_Packages;
- -- Comment needed here ???
+ ---------------------------------------------
+ -- Process_Project_Level_Simple_Attributes --
+ ---------------------------------------------
- if Binder_Pkg /= No_Package then
- Element := In_Tree.Packages.Table (Binder_Pkg);
- Arrays := Element.Decl.Arrays;
- while Arrays /= No_Array loop
- Current_Array := In_Tree.Arrays.Table (Arrays);
+ procedure Process_Project_Level_Simple_Attributes is
+ Attribute_Id : Variable_Id;
+ Attribute : Variable;
+ List : String_List_Id;
- Arr_Elmt_Id := Current_Array.Value;
- while Arr_Elmt_Id /= No_Array_Element loop
- Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id);
+ begin
+ -- Process non associated array attribute at project level
- Get_Language (Arr_Element.Index);
+ Attribute_Id := Data.Decl.Attributes;
+ while Attribute_Id /= No_Variable loop
+ Attribute :=
+ In_Tree.Variable_Elements.Table (Attribute_Id);
- if Current_Language_Index /= No_Language_Index then
- case Current_Array.Name is
- when Name_Driver =>
+ if not Attribute.Value.Default then
+ if Attribute.Name = Name_Library_Builder then
- -- Attribute Driver (<language>)
+ -- Attribute Library_Builder: the application to invoke
+ -- to build libraries.
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Binder_Driver :=
- File_Name_Type (Arr_Element.Value.Value);
+ Data.Config.Library_Builder :=
+ Path_Name_Type (Attribute.Value.Value);
- when Name_Objects_Path =>
+ elsif Attribute.Name = Name_Archive_Builder then
- -- Attribute Objects_Path (<language>)
+ -- Attribute Archive_Builder: the archive builder
+ -- (usually "ar") and its minimum options (usually "cr").
- In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Objects_Path :=
- Arr_Element.Value.Value;
+ List := Attribute.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "archive builder cannot be null",
+ Attribute.Value.Location);
+ end if;
+
+ Put (Into_List => Data.Config.Archive_Builder,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ elsif Attribute.Name = Name_Archive_Indexer then
+
+ -- Attribute Archive_Indexer: the optional archive
+ -- indexer (usually "ranlib") with its minimum options
+ -- (usually none).
+
+ List := Attribute.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "archive indexer cannot be null",
+ Attribute.Value.Location);
+ end if;
+
+ Put (Into_List => Data.Config.Archive_Indexer,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ elsif Attribute.Name = Name_Library_Partial_Linker then
+
+ -- Attribute Library_Partial_Linker: the optional linker
+ -- driver with its minimum options, to partially link
+ -- archives.
+
+ List := Attribute.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "partial linker cannot be null",
+ Attribute.Value.Location);
+ end if;
+
+ Put (Into_List => Data.Config.Lib_Partial_Linker,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ elsif Attribute.Name = Name_Archive_Suffix then
+ Data.Config.Archive_Suffix :=
+ File_Name_Type (Attribute.Value.Value);
+
+ elsif Attribute.Name = Name_Linker_Executable_Option then
+
+ -- Attribute Linker_Executable_Option: optional options
+ -- to specify an executable name. Defaults to "-o".
+
+ List := Attribute.Value.Values;
+
+ if List = Nil_String then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "linker executable option cannot be null",
+ Attribute.Value.Location);
+ end if;
+
+ Put (Into_List => Data.Config.Linker_Executable_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+
+ elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
+
+ -- Attribute Linker_Lib_Dir_Option: optional options
+ -- to specify a library search directory. Defaults to
+ -- "-L".
+
+ Get_Name_String (Attribute.Value.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "linker library directory option cannot be empty",
+ Attribute.Value.Location);
+ end if;
+
+ Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
+
+ elsif Attribute.Name = Name_Linker_Lib_Name_Option then
+
+ -- Attribute Linker_Lib_Name_Option: optional options
+ -- to specify the name of a library to be linked in.
+ -- Defaults to "-l".
+
+ Get_Name_String (Attribute.Value.Value);
+
+ if Name_Len = 0 then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "linker library name option cannot be empty",
+ Attribute.Value.Location);
+ end if;
+
+ Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
+
+ elsif Attribute.Name = Name_Run_Path_Option then
+
+ -- Attribute Run_Path_Option: optional options to
+ -- specify a path for libraries.
+
+ List := Attribute.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List => Data.Config.Run_Path_Option,
+ From_List => List,
+ In_Tree => In_Tree);
+ end if;
+
+ elsif Attribute.Name = Name_Library_Support then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Data.Config.Lib_Support :=
+ Library_Support'Value (Get_Name_String
+ (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value """ &
+ Get_Name_String (Attribute.Value.Value) &
+ """ for Library_Support",
+ Attribute.Value.Location);
+ end;
- when Name_Objects_Path_File =>
+ elsif Attribute.Name = Name_Shared_Library_Prefix then
+ Data.Config.Shared_Lib_Prefix :=
+ File_Name_Type (Attribute.Value.Value);
- -- Attribute Objects_Path_File (<language>)
+ elsif Attribute.Name = Name_Shared_Library_Suffix then
+ Data.Config.Shared_Lib_Suffix :=
+ File_Name_Type (Attribute.Value.Value);
+
+ elsif Attribute.Name = Name_Symbolic_Link_Supported then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Data.Config.Symbolic_Link_Supported :=
+ Boolean'Value (Get_Name_String
+ (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value """ &
+ Get_Name_String (Attribute.Value.Value) &
+ """ for Symbolic_Link_Supported",
+ Attribute.Value.Location);
+ end;
+
+ elsif
+ Attribute.Name = Name_Library_Major_Minor_Id_Supported
+ then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Data.Config.Lib_Maj_Min_Id_Supported :=
+ Boolean'Value (Get_Name_String
+ (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value """ &
+ Get_Name_String (Attribute.Value.Value) &
+ """ for Library_Major_Minor_Id_Supported",
+ Attribute.Value.Location);
+ end;
+
+ elsif
+ Attribute.Name = Name_Library_Auto_Init_Supported
+ then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Data.Config.Auto_Init_Supported :=
+ Boolean'Value (Get_Name_String
+ (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Project,
+ In_Tree,
+ "invalid value """ &
+ Get_Name_String (Attribute.Value.Value) &
+ """ for Library_Auto_Init_Supported",
+ Attribute.Value.Location);
+ end;
+
+ elsif
+ Attribute.Name = Name_Shared_Library_Minimum_Switches
+ then
+ List := Attribute.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List => Data.Config.Shared_Lib_Min_Options,
+ From_List => List,
+ In_Tree => In_Tree);
+ end if;
+
+ elsif
+ Attribute.Name = Name_Library_Version_Switches
+ then
+ List := Attribute.Value.Values;
+
+ if List /= Nil_String then
+ Put (Into_List => Data.Config.Lib_Version_Options,
+ From_List => List,
+ In_Tree => In_Tree);
+ end if;
+ end if;
+ end if;
+
+ Attribute_Id := Attribute.Next;
+ end loop;
+ end Process_Project_Level_Simple_Attributes;
+
+ --------------------------------------------
+ -- Process_Project_Level_Array_Attributes --
+ --------------------------------------------
+
+ procedure Process_Project_Level_Array_Attributes is
+ Current_Array_Id : Array_Id;
+ Current_Array : Array_Data;
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+
+ begin
+ -- Process the associative array attributes at project level
+
+ Current_Array_Id := Data.Decl.Arrays;
+ while Current_Array_Id /= No_Array loop
+ Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
+
+ Element_Id := Current_Array.Value;
+ while Element_Id /= No_Array_Element loop
+ Element := In_Tree.Array_Elements.Table (Element_Id);
+
+ -- Get the name of the language
+
+ Get_Language_Index_Of (Element.Index);
+
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
+ when Name_Toolchain_Description =>
+
+ -- Attribute Toolchain_Description (<language>)
In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Objects_Path_File :=
- Arr_Element.Value.Value;
+ (Lang_Index).Config.Toolchain_Description :=
+ Element.Value.Value;
- when Name_Prefix =>
+ when Name_Toolchain_Version =>
- -- Attribute Prefix (<language>)
+ -- Attribute Toolchain_Version (<language>)
In_Tree.Languages_Data.Table
- (Current_Language_Index).Config.Binder_Prefix :=
- Arr_Element.Value.Value;
+ (Lang_Index).Config.Toolchain_Version :=
+ Element.Value.Value;
when others =>
null;
end case;
end if;
- Arr_Elmt_Id := Arr_Element.Next;
+ Element_Id := Element.Next;
end loop;
- Arrays := Current_Array.Next;
+ Current_Array_Id := Current_Array.Next;
end loop;
+ end Process_Project_Level_Array_Attributes;
+
+ begin
+ Process_Project_Level_Simple_Attributes;
+
+ Process_Project_Level_Array_Attributes;
+
+ Process_Packages;
+
+ -- For unit based languages, set Casing, Dot_Replacement and
+ -- Separate_Suffix in Naming_Data.
+
+ Lang_Index := Data.First_Language_Processing;
+ while Lang_Index /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table
+ (Lang_Index).Name = Name_Ada
+ then
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Casing := Casing;
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Dot_Replacement :=
+ Dot_Replacement;
+
+ if Separate_Suffix /= No_File then
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Naming_Data.Separate_Suffix :=
+ Separate_Suffix;
+ end if;
+
+ exit;
+ end if;
+
+ Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
+ end loop;
+
+ -- Give empty names to various prefixes/suffixes, if they have not
+ -- been specified in the configuration.
+
+ if Data.Config.Archive_Suffix = No_File then
+ Data.Config.Archive_Suffix := Empty_File;
end if;
+
+ if Data.Config.Shared_Lib_Prefix = No_File then
+ Data.Config.Shared_Lib_Prefix := Empty_File;
+ end if;
+
+ if Data.Config.Shared_Lib_Suffix = No_File then
+ Data.Config.Shared_Lib_Suffix := Empty_File;
+ end if;
+
+ Lang_Index := Data.First_Language_Processing;
+ while Lang_Index /= No_Language_Index loop
+ Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
+
+ Current_Language := Lang_Data.Display_Name;
+
+ if Lang_Data.Name = Name_Ada then
+
+ -- For unit based languages, Dot_Replacement, Spec_Suffix and
+ -- Body_Suffix need to be specified.
+
+ if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "Dot_Replacement not specified for Ada",
+ No_Location);
+ end if;
+
+ if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "Spec_Suffix not specified for Ada",
+ No_Location);
+ end if;
+
+ if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "Body_Suffix not specified for Ada",
+ No_Location);
+ end if;
+
+ else
+ -- For file based languages, either Spec_Suffix or Body_Suffix
+ -- need to be specified.
+
+ if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
+ Lang_Data.Config.Naming_Data.Body_Suffix = No_File
+ then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "no suffixes specified for " &
+ Get_Name_String (Current_Language),
+ No_Location);
+ end if;
+ end if;
+
+ -- For all languages, Compiler_Driver needs to be specified
+
+ if Lang_Data.Config.Compiler_Driver = No_File then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "no compiler specified for " &
+ Get_Name_String (Current_Language),
+ No_Location);
+ end if;
+
+ Lang_Index := Lang_Data.Next;
+ end loop;
end Check_Configuration;
----------------------
if Data.Library then
if Get_Mode = Multi_Language then
- Support_For_Libraries := In_Tree.Config.Lib_Support;
+ Support_For_Libraries := Data.Config.Lib_Support;
else
Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
Data : in out Project_Data)
is
Languages : Variable_Value := Nil_Variable_Value;
- Lang : Language_Index;
+ Def_Lang : Variable_Value := Nil_Variable_Value;
+ Def_Lang_Id : Name_Id;
begin
+ Data.First_Language_Processing := No_Language_Index;
Languages :=
Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
+ Def_Lang :=
+ Prj.Util.Value_Of
+ (Name_Default_Language, Data.Decl.Attributes, In_Tree);
Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
Data.Other_Sources_Present := False;
- elsif In_Tree.Default_Language = No_Name then
+ elsif Def_Lang.Default then
Error_Msg
(Project,
In_Tree,
Data.Location);
else
+ Get_Name_String (Def_Lang.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Def_Lang_Id := Name_Find;
In_Tree.Name_Lists.Table (Data.Languages) :=
- (Name => In_Tree.Default_Language, Next => No_Name_List);
+ (Name => Def_Lang_Id, Next => No_Name_List);
Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
Data.First_Language_Processing :=
Language_Data_Table.Last (In_Tree.Languages_Data);
In_Tree.Languages_Data.Table
(Data.First_Language_Processing) := No_Language_Data;
In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Name :=
- In_Tree.Default_Language;
- Get_Name_String (In_Tree.Default_Language);
+ (Data.First_Language_Processing).Name := Def_Lang_Id;
+ Get_Name_String (Def_Lang_Id);
Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
In_Tree.Languages_Data.Table
(Data.First_Language_Processing).Display_Name := Name_Find;
- Lang := In_Tree.First_Language;
-
- while Lang /= No_Language_Index loop
- if In_Tree.Languages_Data.Table (Lang).Name =
- In_Tree.Default_Language
- then
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config :=
- In_Tree.Languages_Data.Table (Lang).Config;
-
- if In_Tree.Languages_Data.Table (Lang).Config.Kind =
- Unit_Based
- then
- Data.Unit_Based_Language_Name :=
- In_Tree.Default_Language;
- Data.Unit_Based_Language_Index :=
- Data.First_Language_Processing;
- end if;
-
- exit;
- end if;
+ if Def_Lang_Id = Name_Ada then
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Kind := Unit_Based;
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Dependency_Kind :=
+ ALI_File;
+ Data.Unit_Based_Language_Name := Name_Ada;
+ Data.Unit_Based_Language_Index :=
+ Data.First_Language_Processing;
+ else
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Kind := File_Based;
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Dependency_Kind :=
+ Makefile;
+ end if;
- Lang := In_Tree.Languages_Data.Table (Lang).Next;
- end loop;
end if;
else
Current : String_List_Id := Languages.Values;
Element : String_Element;
Lang_Name : Name_Id;
- Display_Lang_Name : Name_Id;
Index : Language_Index;
Lang_Data : Language_Data;
NL_Id : Name_List_Index := No_Name_List;
- Config : Language_Config;
begin
if Get_Mode = Ada_Only then
while Current /= Nil_String loop
Element :=
In_Tree.String_Elements.Table (Current);
- Display_Lang_Name := Element.Value;
Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
Lang_Name := Name_Find;
- Name_List_Table.Increment_Last (In_Tree.Name_Lists);
+ NL_Id := Data.Languages;
+ while NL_Id /= No_Name_List loop
+ exit when
+ Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
+ NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
+ end loop;
if NL_Id = No_Name_List then
- Data.Languages :=
- Name_List_Table.Last (In_Tree.Name_Lists);
-
- else
- In_Tree.Name_Lists.Table (NL_Id).Next :=
- Name_List_Table.Last (In_Tree.Name_Lists);
- end if;
+ Name_List_Table.Increment_Last (In_Tree.Name_Lists);
- NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
- In_Tree.Name_Lists.Table (NL_Id) :=
- (Lang_Name, No_Name_List);
+ if Data.Languages = No_Name_List then
+ Data.Languages :=
+ Name_List_Table.Last (In_Tree.Name_Lists);
- if Get_Mode = Ada_Only then
- Index := Language_Indexes.Get (Lang_Name);
+ else
+ NL_Id := Data.Languages;
+ while In_Tree.Name_Lists.Table (NL_Id).Next /=
+ No_Name_List
+ loop
+ NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
+ end loop;
- if Index = No_Language_Index then
- Add_Language_Name (Lang_Name);
- Index := Last_Language_Index;
+ In_Tree.Name_Lists.Table (NL_Id).Next :=
+ Name_List_Table.Last (In_Tree.Name_Lists);
end if;
- Set (Index, True, Data, In_Tree);
- Set (Language_Processing =>
- Default_Language_Processing_Data,
- For_Language => Index,
- In_Project => Data,
- In_Tree => In_Tree);
+ NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
+ In_Tree.Name_Lists.Table (NL_Id) :=
+ (Lang_Name, No_Name_List);
- if Index = Ada_Language_Index then
- Data.Ada_Sources_Present := True;
+ if Get_Mode = Ada_Only then
+ Index := Language_Indexes.Get (Lang_Name);
- else
- Data.Other_Sources_Present := True;
- end if;
+ if Index = No_Language_Index then
+ Add_Language_Name (Lang_Name);
+ Index := Last_Language_Index;
+ end if;
- else
- Index := Data.First_Language_Processing;
+ Set (Index, True, Data, In_Tree);
+ Set (Language_Processing =>
+ Default_Language_Processing_Data,
+ For_Language => Index,
+ In_Project => Data,
+ In_Tree => In_Tree);
- while Index /= No_Language_Index loop
- exit when
- Lang_Name =
- In_Tree.Languages_Data.Table (Index).Name;
- Index := In_Tree.Languages_Data.Table (Index).Next;
- end loop;
+ if Index = Ada_Language_Index then
+ Data.Ada_Sources_Present := True;
- if Index = No_Language_Index then
+ else
+ Data.Other_Sources_Present := True;
+ end if;
+
+ else
Language_Data_Table.Increment_Last
- (In_Tree.Languages_Data);
+ (In_Tree.Languages_Data);
Index :=
Language_Data_Table.Last (In_Tree.Languages_Data);
Lang_Data.Name := Lang_Name;
Lang_Data.Display_Name := Element.Value;
Lang_Data.Next := Data.First_Language_Processing;
- In_Tree.Languages_Data.Table (Index) := Lang_Data;
- Data.First_Language_Processing := Index;
- Index := In_Tree.First_Language;
-
- while Index /= No_Language_Index loop
- exit when
- Lang_Name =
- In_Tree.Languages_Data.Table (Index).Name;
- Index :=
- In_Tree.Languages_Data.Table (Index).Next;
- end loop;
-
- if Index = No_Language_Index then
- Error_Msg
- (Project, In_Tree,
- "language """ &
- Get_Name_String (Display_Lang_Name) &
- """ not found in configuration",
- Languages.Location);
+ if Lang_Name = Name_Ada then
+ Lang_Data.Config.Kind := Unit_Based;
+ Lang_Data.Config.Dependency_Kind := ALI_File;
+ Data.Unit_Based_Language_Name := Name_Ada;
+ Data.Unit_Based_Language_Index := Index;
else
- Config :=
- In_Tree.Languages_Data.Table (Index).Config;
-
- -- Duplicate name lists
-
- Duplicate
- (Config.Compiler_Min_Options, In_Tree);
- Duplicate
- (Config.Compilation_PIC_Option, In_Tree);
- Duplicate
- (Config.Mapping_File_Switches, In_Tree);
- Duplicate
- (Config.Config_File_Switches, In_Tree);
- Duplicate
- (Config.Dependency_Option, In_Tree);
- Duplicate
- (Config.Compute_Dependency, In_Tree);
- Duplicate
- (Config.Include_Option, In_Tree);
- Duplicate
- (Config.Binder_Min_Options, In_Tree);
-
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config :=
- Config;
-
- if Config.Kind = Unit_Based then
- if
- Data.Unit_Based_Language_Name = No_Name
- then
- Data.Unit_Based_Language_Name := Lang_Name;
- Data.Unit_Based_Language_Index :=
- Language_Data_Table.Last
- (In_Tree.Languages_Data);
-
- else
- Error_Msg
- (Project, In_Tree,
- "not allowed to have several " &
- "unit-based languages in the same " &
- "project",
- Languages.Location);
- end if;
- end if;
+ Lang_Data.Config.Kind := File_Based;
+ Lang_Data.Config.Dependency_Kind := Makefile;
end if;
+
+ In_Tree.Languages_Data.Table (Index) := Lang_Data;
+ Data.First_Language_Processing := Index;
end if;
end if;
begin
if Get_Mode = Multi_Language then
- Auto_Init_Supported := In_Tree.Config.Auto_Init_Supported;
+ Auto_Init_Supported := Data.Config.Auto_Init_Supported;
else
Auto_Init_Supported :=
------------------------------------------------------------------------------
+
-- --
-- GNAT COMPILER COMPONENTS --
-- --
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
-with Prj.Util; use Prj.Util;
with Sinput; use Sinput;
with Snames;
When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True)
is
- Obj_Dir : Path_Name_Type;
- Extending : Project_Id;
- Extending2 : Project_Id;
- Packages : Package_Id;
- Element : Package_Element;
-
- procedure Process_Attributes (Attrs : Variable_Id);
-
- ------------------------
- -- Process_Attributes --
- ------------------------
-
- procedure Process_Attributes (Attrs : Variable_Id) is
- Attribute_Id : Variable_Id;
- Attribute : Variable;
- List : String_List_Id;
-
- begin
- -- Loop through attributes
-
- Attribute_Id := Attrs;
- while Attribute_Id /= No_Variable loop
- Attribute :=
- In_Tree.Variable_Elements.Table (Attribute_Id);
-
- if not Attribute.Value.Default then
- case Attribute.Name is
- when Snames.Name_Driver =>
-
- -- Attribute Linker'Driver: the default linker to use
-
- In_Tree.Config.Linker :=
- Path_Name_Type (Attribute.Value.Value);
-
- when Snames.Name_Required_Switches =>
-
- -- Attribute Linker'Required_Switches: the minimum
- -- options to use when invoking the linker
-
- Put (Into_List =>
- In_Tree.Config.Minimum_Linker_Options,
- From_List => Attribute.Value.Values,
- In_Tree => In_Tree);
-
- when Snames.Name_Executable_Suffix =>
-
- -- Attribute Executable_Suffix: the suffix of the
- -- executables.
-
- In_Tree.Config.Executable_Suffix :=
- Attribute.Value.Value;
-
- when Snames.Name_Library_Builder =>
-
- -- Attribute Library_Builder: the application to invoke
- -- to build libraries.
-
- In_Tree.Config.Library_Builder :=
- Path_Name_Type (Attribute.Value.Value);
-
- when Snames.Name_Archive_Builder =>
-
- -- Attribute Archive_Builder: the archive builder
- -- (usually "ar") and its minimum options (usually "cr").
-
- List := Attribute.Value.Values;
-
- if List = Nil_String then
- Error_Msg
- ("archive builder cannot be null",
- Attribute.Value.Location);
- end if;
-
- Put (Into_List => In_Tree.Config.Archive_Builder,
- From_List => List,
- In_Tree => In_Tree);
-
- when Snames.Name_Archive_Indexer =>
-
- -- Attribute Archive_Indexer: the optional archive
- -- indexer (usually "ranlib") with its minimum options
- -- (usually none).
-
- List := Attribute.Value.Values;
-
- if List = Nil_String then
- Error_Msg
- ("archive indexer cannot be null",
- Attribute.Value.Location);
- end if;
-
- Put (Into_List => In_Tree.Config.Archive_Indexer,
- From_List => List,
- In_Tree => In_Tree);
-
- when Snames.Name_Library_Partial_Linker =>
-
- -- Attribute Library_Partial_Linker: the optional linker
- -- driver with its minimum options, to partially link
- -- archives.
-
- List := Attribute.Value.Values;
-
- if List = Nil_String then
- Error_Msg
- ("partial linker cannot be null",
- Attribute.Value.Location);
- end if;
-
- Put (Into_List => In_Tree.Config.Lib_Partial_Linker,
- From_List => List,
- In_Tree => In_Tree);
-
- when Snames.Name_Archive_Suffix =>
- In_Tree.Config.Archive_Suffix :=
- File_Name_Type (Attribute.Value.Value);
-
- when Snames.Name_Linker_Executable_Option =>
-
- -- Attribute Linker_Executable_Option: optional options
- -- to specify an executable name. Defaults to "-o".
-
- List := Attribute.Value.Values;
-
- if List = Nil_String then
- Error_Msg
- ("linker executable option cannot be null",
- Attribute.Value.Location);
- end if;
-
- Put (Into_List =>
- In_Tree.Config.Linker_Executable_Option,
- From_List => List,
- In_Tree => In_Tree);
-
- when Snames.Name_Linker_Lib_Dir_Option =>
-
- -- Attribute Linker_Lib_Dir_Option: optional options
- -- to specify a library search directory. Defaults to
- -- "-L".
-
- Get_Name_String (Attribute.Value.Value);
-
- if Name_Len = 0 then
- Error_Msg
- ("linker library directory option cannot be empty",
- Attribute.Value.Location);
- end if;
-
- In_Tree.Config.Linker_Lib_Dir_Option :=
- Attribute.Value.Value;
-
- when Snames.Name_Linker_Lib_Name_Option =>
-
- -- Attribute Linker_Lib_Name_Option: optional options
- -- to specify the name of a library to be linked in.
- -- Defaults to "-l".
-
- Get_Name_String (Attribute.Value.Value);
-
- if Name_Len = 0 then
- Error_Msg
- ("linker library name option cannot be empty",
- Attribute.Value.Location);
- end if;
-
- In_Tree.Config.Linker_Lib_Name_Option :=
- Attribute.Value.Value;
-
- when Snames.Name_Run_Path_Option =>
-
- -- Attribute Run_Path_Option: optional options to
- -- specify a path for libraries.
-
- List := Attribute.Value.Values;
-
- if List /= Nil_String then
- Put (Into_List => In_Tree.Config.Run_Path_Option,
- From_List => List,
- In_Tree => In_Tree);
- end if;
-
- when Snames.Name_Library_Support =>
- declare
- pragma Unsuppress (All_Checks);
- begin
- In_Tree.Config.Lib_Support :=
- Library_Support'Value (Get_Name_String
- (Attribute.Value.Value));
- exception
- when Constraint_Error =>
- Error_Msg
- ("invalid value """ &
- Get_Name_String (Attribute.Value.Value) &
- """ for Library_Support",
- Attribute.Value.Location);
- end;
-
- when Snames.Name_Shared_Library_Prefix =>
- In_Tree.Config.Shared_Lib_Prefix :=
- File_Name_Type (Attribute.Value.Value);
-
- when Snames.Name_Shared_Library_Suffix =>
- In_Tree.Config.Shared_Lib_Suffix :=
- File_Name_Type (Attribute.Value.Value);
-
- when Snames.Name_Symbolic_Link_Supported =>
- declare
- pragma Unsuppress (All_Checks);
- begin
- In_Tree.Config.Symbolic_Link_Supported :=
- Boolean'Value (Get_Name_String
- (Attribute.Value.Value));
- exception
- when Constraint_Error =>
- Error_Msg
- ("invalid value """ &
- Get_Name_String (Attribute.Value.Value) &
- """ for Symbolic_Link_Supported",
- Attribute.Value.Location);
- end;
-
- when Snames.Name_Library_Major_Minor_Id_Supported =>
- declare
- pragma Unsuppress (All_Checks);
- begin
- In_Tree.Config.Lib_Maj_Min_Id_Supported :=
- Boolean'Value (Get_Name_String
- (Attribute.Value.Value));
- exception
- when Constraint_Error =>
- Error_Msg
- ("invalid value """ &
- Get_Name_String (Attribute.Value.Value) &
- """ for Library_Major_Minor_Id_Supported",
- Attribute.Value.Location);
- end;
-
- when Snames.Name_Library_Auto_Init_Supported =>
- declare
- pragma Unsuppress (All_Checks);
- begin
- In_Tree.Config.Auto_Init_Supported :=
- Boolean'Value (Get_Name_String
- (Attribute.Value.Value));
- exception
- when Constraint_Error =>
- Error_Msg
- ("invalid value """ &
- Get_Name_String (Attribute.Value.Value) &
- """ for Library_Auto_Init_Supported",
- Attribute.Value.Location);
- end;
-
- when Snames.Name_Shared_Library_Minimum_Switches =>
- List := Attribute.Value.Values;
-
- if List /= Nil_String then
- Put (Into_List =>
- In_Tree.Config.Shared_Lib_Min_Options,
- From_List => List,
- In_Tree => In_Tree);
- end if;
-
- when Snames.Name_Library_Version_Switches =>
- List := Attribute.Value.Values;
-
- if List /= Nil_String then
- Put (Into_List =>
- In_Tree.Config.Lib_Version_Options,
- From_List => List,
- In_Tree => In_Tree);
- end if;
-
- when others =>
- null;
- end case;
- end if;
-
- Attribute_Id := Attribute.Next;
- end loop;
- end Process_Attributes;
-
begin
- Error_Report := Report_Error;
- Success := True;
-
- if Reset_Tree then
-
- -- Make sure there are no projects in the data structure
-
- Project_Table.Set_Last (In_Tree.Projects, No_Project);
- end if;
-
- Processed_Projects.Reset;
-
- -- And process the main project and all of the projects it depends on,
- -- recursively.
-
- Recursive_Process
- (Project => Project,
- In_Tree => In_Tree,
+ Process_Project_Tree_Phase_1
+ (In_Tree => In_Tree,
+ Project => Project,
+ Success => Success,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
- Extended_By => No_Project);
+ Report_Error => Report_Error,
+ Reset_Tree => Reset_Tree);
if not In_Configuration then
-
- if Project /= No_Project then
- Check
- (In_Tree, Project, Follow_Links, When_No_Sources);
- end if;
-
- -- If main project is an extending all project, set the object
- -- directory of all virtual extending projects to the object
- -- directory of the main project.
-
- if Project /= No_Project
- and then
- Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
- then
- declare
- Object_Dir : constant Path_Name_Type :=
- In_Tree.Projects.Table
- (Project).Object_Directory;
- begin
- for Index in
- Project_Table.First .. Project_Table.Last (In_Tree.Projects)
- loop
- if In_Tree.Projects.Table (Index).Virtual then
- In_Tree.Projects.Table (Index).Object_Directory :=
- Object_Dir;
- end if;
- end loop;
- end;
- end if;
-
- -- Check that no extending project shares its object directory with
- -- the project(s) it extends.
-
- if Project /= No_Project then
- for Proj in
- Project_Table.First .. Project_Table.Last (In_Tree.Projects)
- loop
- Extending := In_Tree.Projects.Table (Proj).Extended_By;
-
- if Extending /= No_Project then
- Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
-
- -- Check that a project being extended does not share its
- -- object directory with any project that extends it,
- -- directly or indirectly, including a virtual extending
- -- project.
-
- -- Start with the project directly extending it
-
- Extending2 := Extending;
- while Extending2 /= No_Project loop
- if In_Tree.Projects.Table (Extending2).Ada_Sources /=
- Nil_String
- and then
- In_Tree.Projects.Table (Extending2).Object_Directory =
- Obj_Dir
- then
- if In_Tree.Projects.Table (Extending2).Virtual then
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Proj).Display_Name;
-
- if Error_Report = null then
- Error_Msg
- ("project %% cannot be extended by a virtual" &
- " project with the same object directory",
- In_Tree.Projects.Table (Proj).Location);
- else
- Error_Report
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot be extended by a virtual " &
- "project with the same object directory",
- Project, In_Tree);
- end if;
-
- else
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Extending2).Display_Name;
- Error_Msg_Name_2 :=
- In_Tree.Projects.Table (Proj).Display_Name;
-
- if Error_Report = null then
- Error_Msg
- ("project %% cannot extend project %%",
- In_Tree.Projects.Table (Extending2).Location);
- Error_Msg
- ("\they share the same object directory",
- In_Tree.Projects.Table (Extending2).Location);
-
- else
- Error_Report
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot extend project """ &
- Get_Name_String (Error_Msg_Name_2) & """",
- Project, In_Tree);
- Error_Report
- ("they share the same object directory",
- Project, In_Tree);
- end if;
- end if;
- end if;
-
- -- Continue with the next extending project, if any
-
- Extending2 :=
- In_Tree.Projects.Table (Extending2).Extended_By;
- end loop;
- end if;
- end loop;
- end if;
-
- -- Get the global configuration
-
- if Project /= No_Project then
-
- Process_Attributes
- (In_Tree.Projects.Table (Project).Decl.Attributes);
-
- -- Loop through packages ???
-
- Packages := In_Tree.Projects.Table (Project).Decl.Packages;
- while Packages /= No_Package loop
- Element := In_Tree.Packages.Table (Packages);
-
- case Element.Name is
- when Snames.Name_Builder =>
-
- -- Process attributes of package Builder
-
- Process_Attributes (Element.Decl.Attributes);
-
- when Snames.Name_Linker =>
-
- -- Process attributes of package Linker
-
- Process_Attributes (Element.Decl.Attributes);
-
- when others =>
- null;
- end case;
-
- Packages := Element.Next;
- end loop;
- end if;
+ Process_Project_Tree_Phase_2
+ (In_Tree => In_Tree,
+ Project => Project,
+ Success => Success,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Report_Error => Report_Error,
+ Follow_Links => Follow_Links,
+ When_No_Sources => When_No_Sources);
end if;
-
- Success :=
- Total_Errors_Detected = 0
- and then
- (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process;
-------------------------------
In_Tree.Packages.Table (Pkg).Decl.Packages;
In_Tree.Packages.Table (Pkg).Decl.Packages :=
New_Pkg;
+
else
The_New_Package.Next :=
In_Tree.Projects.Table (Project).Decl.Packages;
N_Variable_Declaration =>
if Expression_Of (Current_Item, From_Project_Node_Tree) =
- Empty_Node
+ Empty_Node
then
-- It must be a full associative array attribute declaration
-- Last new element id created
Orig_Element : Array_Element_Id := No_Array_Element;
- -- Current array element in the original associative
- -- array.
+ -- Current array element in original associative array
Next_Element : Array_Element_Id := No_Array_Element;
-- Id of the array element that follows the new element.
-- declared, and the array elements declared are reused.
begin
- -- First, find if the associative array attribute already
+ -- First find if the associative array attribute already
-- has elements declared.
if Pkg /= No_Package then
(Orig_Project).Decl.Arrays;
else
- -- If in a package, find the package where the
- -- value is declared.
+ -- If in a package, find the package where the value
+ -- is declared.
Orig_Package_Name :=
Name_Of
-- Now look for the array
- while Orig_Array /= No_Array and then
- In_Tree.Arrays.Table (Orig_Array).Name /=
+ while Orig_Array /= No_Array
+ and then In_Tree.Arrays.Table (Orig_Array).Name /=
Current_Item_Name
loop
Orig_Array := In_Tree.Arrays.Table
("associative array value cannot be found",
Location_Of
(Current_Item, From_Project_Node_Tree));
-
else
Error_Report
("associative array value cannot be found",
The_Variable : Variable_Id := No_Variable;
Current_Item_Name : constant Name_Id :=
- Name_Of (Current_Item, From_Project_Node_Tree);
+ Name_Of
+ (Current_Item,
+ From_Project_Node_Tree);
begin
-- Process a typed variable declaration
("no value defined for %%",
Location_Of
(Current_Item, From_Project_Node_Tree));
-
else
Error_Report
("no value defined for " &
else
declare
- Current_String : Project_Node_Id :=
- First_Literal_String
- (String_Type_Of
- (Current_Item,
- From_Project_Node_Tree),
- From_Project_Node_Tree);
+ Current_String : Project_Node_Id;
begin
-- Loop through all the valid strings for the
-- string type and compare to the string value.
+ Current_String :=
+ First_Literal_String
+ (String_Type_Of (Current_Item,
+ From_Project_Node_Tree),
+ From_Project_Node_Tree);
while Current_String /= Empty_Node
and then
String_Value_Of
end if;
end if;
+ -- Comment here ???
+
if Kind_Of (Current_Item, From_Project_Node_Tree) /=
N_Attribute_Declaration
or else
end if;
- else
- -- Associative array attribute
+ -- Associative array attribute
+ else
-- Get the string index
Get_Name_String
(The_Array).Next;
end loop;
- -- If the array cannot be found, create a new
- -- entry in the list. As The_Array_Element is
- -- initialized to No_Array_Element, a new element
- -- will be created automatically later.
+ -- If the array cannot be found, create a new entry
+ -- in the list. As The_Array_Element is initialized
+ -- to No_Array_Element, a new element will be
+ -- created automatically later
if The_Array = No_Array then
Array_Table.Increment_Last
The_Array;
end if;
- -- Otherwise, initialize The_Array_Element as the
+ -- Otherwise initialize The_Array_Element as the
-- head of the element list.
else
(The_Array_Element).Next;
end loop;
- -- If no such element were found, create a new
- -- one and insert it in the element list, with
- -- the propoer value.
+ -- If no such element were found, create a new one
+ -- and insert it in the element list, with the
+ -- propoer value.
if The_Array_Element = No_Array_Element then
Array_Element_Table.Increment_Last
when N_Case_Construction =>
declare
- The_Project : Project_Id := Project;
+ The_Project : Project_Id := Project;
-- The id of the project of the case variable
- The_Package : Package_Id := Pkg;
+ The_Package : Package_Id := Pkg;
-- The id of the package, if any, of the case variable
- The_Variable : Variable_Value := Nil_Variable_Value;
+ The_Variable : Variable_Value := Nil_Variable_Value;
-- The case variable
- Case_Value : Name_Id := No_Name;
+ Case_Value : Name_Id := No_Name;
-- The case variable value
Case_Item : Project_Node_Id := Empty_Node;
end loop;
end Process_Declarative_Items;
+ ----------------------------------
+ -- Process_Project_Tree_Phase_1 --
+ ----------------------------------
+
+ procedure Process_Project_Tree_Phase_1
+ (In_Tree : Project_Tree_Ref;
+ Project : out Project_Id;
+ Success : out Boolean;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Report_Error : Put_Line_Access;
+ Reset_Tree : Boolean := True)
+ is
+ begin
+ Error_Report := Report_Error;
+ Success := True;
+
+ if Reset_Tree then
+
+ -- Make sure there are no projects in the data structure
+
+ Project_Table.Set_Last (In_Tree.Projects, No_Project);
+ end if;
+
+ Processed_Projects.Reset;
+
+ -- And process the main project and all of the projects it depends on,
+ -- recursively.
+
+ Recursive_Process
+ (Project => Project,
+ In_Tree => In_Tree,
+ From_Project_Node => From_Project_Node,
+ From_Project_Node_Tree => From_Project_Node_Tree,
+ Extended_By => No_Project);
+
+ end Process_Project_Tree_Phase_1;
+
+ ----------------------------------
+ -- Process_Project_Tree_Phase_2 --
+ ----------------------------------
+
+ procedure Process_Project_Tree_Phase_2
+ (In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Success : out Boolean;
+ From_Project_Node : Project_Node_Id;
+ From_Project_Node_Tree : Project_Node_Tree_Ref;
+ Report_Error : Put_Line_Access;
+ Follow_Links : Boolean := True;
+ When_No_Sources : Error_Warning := Error)
+ is
+ Obj_Dir : Path_Name_Type;
+ Extending : Project_Id;
+ Extending2 : Project_Id;
+
+ -- Start of processing for Process_Project_Tree_Phase_2
+
+ begin
+ Error_Report := Report_Error;
+ Success := True;
+
+ if Project /= No_Project then
+ Check
+ (In_Tree, Project, Follow_Links, When_No_Sources);
+ end if;
+
+ -- If main project is an extending all project, set the object
+ -- directory of all virtual extending projects to the object
+ -- directory of the main project.
+
+ if Project /= No_Project
+ and then
+ Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
+ then
+ declare
+ Object_Dir : constant Path_Name_Type :=
+ In_Tree.Projects.Table
+ (Project).Object_Directory;
+ begin
+ for Index in
+ Project_Table.First .. Project_Table.Last (In_Tree.Projects)
+ loop
+ if In_Tree.Projects.Table (Index).Virtual then
+ In_Tree.Projects.Table (Index).Object_Directory :=
+ Object_Dir;
+ end if;
+ end loop;
+ end;
+ end if;
+
+ -- Check that no extending project shares its object directory with
+ -- the project(s) it extends.
+
+ if Project /= No_Project then
+ for Proj in
+ Project_Table.First .. Project_Table.Last (In_Tree.Projects)
+ loop
+ Extending := In_Tree.Projects.Table (Proj).Extended_By;
+
+ if Extending /= No_Project then
+ Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
+
+ -- Check that a project being extended does not share its
+ -- object directory with any project that extends it, directly
+ -- or indirectly, including a virtual extending project.
+
+ -- Start with the project directly extending it
+
+ Extending2 := Extending;
+ while Extending2 /= No_Project loop
+ if In_Tree.Projects.Table (Extending2).Ada_Sources /=
+ Nil_String
+ and then
+ In_Tree.Projects.Table (Extending2).Object_Directory =
+ Obj_Dir
+ then
+ if In_Tree.Projects.Table (Extending2).Virtual then
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Proj).Display_Name;
+
+ if Error_Report = null then
+ Error_Msg
+ ("project %% cannot be extended by a virtual" &
+ " project with the same object directory",
+ In_Tree.Projects.Table (Proj).Location);
+ else
+ Error_Report
+ ("project """ &
+ Get_Name_String (Error_Msg_Name_1) &
+ """ cannot be extended by a virtual " &
+ "project with the same object directory",
+ Project, In_Tree);
+ end if;
+
+ else
+ Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Extending2).Display_Name;
+ Error_Msg_Name_2 :=
+ In_Tree.Projects.Table (Proj).Display_Name;
+
+ if Error_Report = null then
+ Error_Msg
+ ("project %% cannot extend project %%",
+ In_Tree.Projects.Table (Extending2).Location);
+ Error_Msg
+ ("\they share the same object directory",
+ In_Tree.Projects.Table (Extending2).Location);
+
+ else
+ Error_Report
+ ("project """ &
+ Get_Name_String (Error_Msg_Name_1) &
+ """ cannot extend project """ &
+ Get_Name_String (Error_Msg_Name_2) & """",
+ Project, In_Tree);
+ Error_Report
+ ("they share the same object directory",
+ Project, In_Tree);
+ end if;
+ end if;
+ end if;
+
+ -- Continue with the next extending project, if any
+
+ Extending2 :=
+ In_Tree.Projects.Table (Extending2).Extended_By;
+ end loop;
+ end if;
+ end loop;
+ end if;
+
+ Success :=
+ Total_Errors_Detected = 0
+ and then
+ (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
+ end Process_Project_Tree_Phase_2;
+
---------------------
-- Recursive_Check --
---------------------
Recursive_Process
(In_Tree => In_Tree,
Project => Processed_Data.Extends,
- From_Project_Node =>
- Extended_Project_Of
- (Declaration_Node, From_Project_Node_Tree),
+ From_Project_Node => Extended_Project_Of
+ (Declaration_Node,
+ From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => Project);
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package,
- Item =>
- First_Declarative_Item_Of
- (Declaration_Node, From_Project_Node_Tree));
+ Item => First_Declarative_Item_Of
+ (Declaration_Node,
+ From_Project_Node_Tree));
-- If it is an extending project, inherit all packages
-- from the extended project that are not explicitely defined
Processed_Data := In_Tree.Projects.Table (Project);
declare
- Extended_Pkg : Package_Id :=
- In_Tree.Projects.Table
- (Processed_Data.Extends).Decl.Packages;
- Current_Pkg : Package_Id;
- Element : Package_Element;
- First : constant Package_Id :=
- Processed_Data.Decl.Packages;
- Attribute1 : Variable_Id;
- Attribute2 : Variable_Id;
- Attr_Value1 : Variable;
+ Extended_Pkg : Package_Id;
+ Current_Pkg : Package_Id;
+ Element : Package_Element;
+ First : constant Package_Id :=
+ Processed_Data.Decl.Packages;
+ Attribute1 : Variable_Id;
+ Attribute2 : Variable_Id;
+ Attr_Value1 : Variable;
Attr_Value2 : Variable;
begin
+ Extended_Pkg :=
+ In_Tree.Projects.Table
+ (Processed_Data.Extends).Decl.Packages;
while Extended_Pkg /= No_Package loop
Element :=
In_Tree.Packages.Table (Extended_Pkg);
Current_Pkg := First;
-
+ while Current_Pkg /= No_Package
+ and then In_Tree.Packages.Table (Current_Pkg).Name /=
+ Element.Name
loop
- exit when Current_Pkg = No_Package
- or else In_Tree.Packages.Table
- (Current_Pkg).Name = Element.Name;
- Current_Pkg := In_Tree.Packages.Table
- (Current_Pkg).Next;
+ Current_Pkg :=
+ In_Tree.Packages.Table (Current_Pkg).Next;
end loop;
if Current_Pkg = No_Package then
Package_Table.Increment_Last
(In_Tree.Packages);
- Current_Pkg := Package_Table.Last
- (In_Tree.Packages);
+ Current_Pkg := Package_Table.Last (In_Tree.Packages);
In_Tree.Packages.Table (Current_Pkg) :=
(Name => Element.Name,
- Decl => Element.Decl,
+ Decl => No_Declarations,
Parent => No_Package,
Next => Processed_Data.Decl.Packages);
Processed_Data.Decl.Packages := Current_Pkg;
+ Copy_Package_Declarations
+ (From => Element.Decl,
+ To => In_Tree.Packages.Table (Current_Pkg).Decl,
+ New_Loc => No_Location,
+ In_Tree => In_Tree);
end if;
Extended_Pkg := Element.Next;
Attribute2 :=
In_Tree.Projects.Table
(Processed_Data.Extends).Decl.Attributes;
-
while Attribute2 /= No_Variable loop
Attr_Value2 := In_Tree.Variable_Elements.
Table (Attribute2);
OSDN Git Service
