Skip to content

R
riscv-gcc-1
Commit a70f5d82 by Vincent Celier Committed by Arnaud Charlet
Options

makeutl.ads (Main_Config_Project): Moved to gpr_util.ads 

2007-09-26  Vincent Celier  <celier@adacore.com>

	* makeutl.ads (Main_Config_Project): Moved to gpr_util.ads

	* prj.ads, prj.adb (Default_Language): Remove function, no longer used
	Replace components Compiler_Min_Options and Binder_Min_Options with
	Compiler_Required_Switches and Binder_Required_Switches in record
	Language_Config.
	Remove components Default_Language and Config in Project_Tree_Data,
	no longer used.

	* prj-attr.adb: New attributes Required_Switches (<language>) in
	packages Compiler and Binder.

	* prj-nmsc.adb: Major rewrite of the processing of configuration
	attributes for gprbuild. No impact on GNAT tools.

	* prj-proc.ads, prj-proc.adb (Process_Project_Tree_Phase_2): No longer
	process configuration attributes: this is done in Prj.Nmsc.Check.
	(Recursive_Process): Make a full copy of packages inherited from project
	being extended, instead of a shallow copy.
	(Process_Project_Tree_Phase_1): New procedure
	(Process_Project_Tree_Phase_1): New procedure
	(Process): Implementation now uses the two new procedures

	* prj-util.adb (Executable_Of): Get the suffix and the default suffix
	from the project config, not the tree config that no longer exists.

From-SVN: r128797
parent 15cf0748
Showing with 1405 additions and 961 deletions
gcc/ada/makeutl.ads
...@@ -43,9 +43,6 @@ package Makeutl is ...@@ -43,9 +43,6 @@ package Makeutl is
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
-- The project tree -- The project tree
Main_Config_Project : Project_Id;
-- The project id of the main configuration project
procedure Add procedure Add
(Option : String_Access; (Option : String_Access;
To : in out String_List_Access; To : in out String_List_Access;
......
gcc/ada/prj-attr.adb
...@@ -156,6 +156,7 @@ package body Prj.Attr is ...@@ -156,6 +156,7 @@ package body Prj.Attr is
-- Configuration - Compiling -- Configuration - Compiling
"Sadriver#" & "Sadriver#" &
"Larequired_switches#" &
"Lapic_option#" & "Lapic_option#" &
-- Configuration - Mapping files -- Configuration - Mapping files
...@@ -208,6 +209,7 @@ package body Prj.Attr is ...@@ -208,6 +209,7 @@ package body Prj.Attr is
-- Configuration - Binding -- Configuration - Binding
"Sadriver#" & "Sadriver#" &
"Larequired_switches#" &
"Saprefix#" & "Saprefix#" &
"Saobjects_path#" & "Saobjects_path#" &
"Saobjects_path_file#" & "Saobjects_path_file#" &
......
gcc/ada/prj-nmsc.adb
...@@ -939,368 +939,1118 @@ package body Prj.Nmsc is ...@@ -939,368 +939,1118 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data) Data : in out Project_Data)
is is
Compiler_Pkg : constant Package_Id := Dot_Replacement : File_Name_Type := No_File;
Value_Of (Name_Compiler, Data.Decl.Packages, In_Tree); Casing : Casing_Type := All_Lower_Case;
Binder_Pkg : constant Package_Id := Separate_Suffix : File_Name_Type := No_File;
Value_Of (Name_Binder, Data.Decl.Packages, In_Tree);
Element : Package_Element;
Arrays : Array_Id; Lang_Index : Language_Index := No_Language_Index;
Current_Array : Array_Data; -- The index of the language data being checked
Arr_Elmt_Id : Array_Element_Id;
Arr_Element : Array_Element;
List : String_List_Id;
Current_Language_Index : Language_Index; Current_Language : Name_Id := No_Name;
-- The name of the language
procedure Get_Language (Name : Name_Id); Lang_Data : Language_Data;
-- Check if this is the name of a language of the project and -- The data of the language being checked
-- set Current_Language_Index accordingly.
------------------ procedure Get_Language_Index_Of (Language : Name_Id);
-- Get_Language -- -- 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; Real_Language : Name_Id;
begin begin
Get_Name_String (Name); Get_Name_String (Language);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Real_Language := Name_Find; Real_Language := Name_Find;
Current_Language_Index := Data.First_Language_Processing; -- Nothing to do if the language is the same as the current language
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;
-- 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 Lang_Index = No_Language_Index then
if Compiler_Pkg /= No_Package then Current_Language := No_Name;
Element := In_Tree.Packages.Table (Compiler_Pkg); else
Current_Language := Real_Language;
end if;
end if;
end Get_Language_Index_Of;
Arrays := Element.Decl.Arrays; ----------------------
while Arrays /= No_Array loop -- Process_Packages --
Current_Array := In_Tree.Arrays.Table (Arrays); ----------------------
Arr_Elmt_Id := Current_Array.Value; procedure Process_Packages is
while Arr_Elmt_Id /= No_Array_Element loop Packages : Package_Id;
Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id); Element : Package_Element;
Get_Language (Arr_Element.Index);
if Current_Language_Index /= No_Language_Index then procedure Process_Binder (Arrays : Array_Id);
case Current_Array.Name is -- Process the associate array attributes of package Binder
when Name_Dependency_Switches =>
List := Arr_Element.Value.Values;
if List = Nil_String then procedure Process_Builder (Attributes : Variable_Id);
Error_Msg -- Process the simple attributes of package Builder
(Project, In_Tree,
"dependency option cannot be null",
Arr_Element.Value.Location);
end if;
Put (Into_List => procedure Process_Compiler (Arrays : Array_Id);
In_Tree.Languages_Data.Table -- Process the associate array attributes of package Compiler
(Current_Language_Index)
.Config.Dependency_Option,
From_List => List,
In_Tree => In_Tree);
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 -- Process_Binder --
(Project, In_Tree, --------------------
"compute dependency cannot be null",
Arr_Element.Value.Location);
end if;
Put (Into_List => procedure Process_Binder (Arrays : Array_Id) is
In_Tree.Languages_Data.Table Current_Array_Id : Array_Id;
(Current_Language_Index) Current_Array : Array_Data;
.Config.Compute_Dependency, Element_Id : Array_Element_Id;
From_List => List, Element : Array_Element;
In_Tree => In_Tree);
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 -- Get the name of the language
Error_Msg
(Project, In_Tree,
"include option cannot be null",
Arr_Element.Value.Location);
end if;
Put (Into_List => Get_Language_Index_Of (Element.Index);
In_Tree.Languages_Data.Table
(Current_Language_Index).Config.Include_Option,
From_List => List,
In_Tree => In_Tree);
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 In_Tree.Languages_Data.Table
(Current_Language_Index).Config.Include_Path := (Lang_Index).Config.Binder_Driver :=
Arr_Element.Value.Value; 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 -- Attribute Prefix (<language>)
(Current_Language_Index).Config.Include_Path_File :=
Arr_Element.Value.Value;
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 In_Tree.Languages_Data.Table
Error_Msg (Lang_Index).Config.Objects_Path :=
(Project, In_Tree, Element.Value.Value;
"compiler driver name cannot be empty",
Arr_Element.Value.Location);
end if;
In_Tree.Languages_Data.Table when Name_Objects_Path_File =>
(Current_Language_Index).Config.Compiler_Driver :=
File_Name_Type (Arr_Element.Value.Value);
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 => Element_Id := Element.Next;
In_Tree.Languages_Data.Table end loop;
(Current_Language_Index).Config.
Compiler_Min_Options,
From_List => List,
In_Tree => In_Tree);
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 begin
Error_Msg -- Process non associated array attribute from package Builder
(Project, In_Tree,
"compiler PIC option cannot be null",
Arr_Element.Value.Location);
end if;
Put (Into_List => Attribute_Id := Attributes;
In_Tree.Languages_Data.Table while Attribute_Id /= No_Variable loop
(Current_Language_Index).Config. Attribute :=
Compilation_PIC_Option, In_Tree.Variable_Elements.Table (Attribute_Id);
From_List => List,
In_Tree => In_Tree);
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 Attribute_Id := Attribute.Next;
Error_Msg end loop;
(Project, In_Tree, end Process_Builder;
"mapping file switches cannot be null",
Arr_Element.Value.Location);
end if;
Put (Into_List => ----------------------
In_Tree.Languages_Data.Table -- Process_Compiler --
(Current_Language_Index).Config. ----------------------
Mapping_File_Switches,
From_List => List,
In_Tree => In_Tree);
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_Array_Id := Arrays;
(Current_Language_Index) while Current_Array_Id /= No_Array loop
.Config.Mapping_Spec_Suffix := Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
File_Name_Type (Arr_Element.Value.Value);
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 Get_Language_Index_Of (Element.Index);
(Current_Language_Index)
.Config.Mapping_Body_Suffix :=
File_Name_Type (Arr_Element.Value.Value);
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 if List = Nil_String then
Error_Msg Error_Msg
(Project, In_Tree, (Project,
"config file switches cannot be null", In_Tree,
Arr_Element.Value.Location); "dependency option cannot be null",
end if; Element.Value.Location);
end if;
Put (Into_List => Put (Into_List =>
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Current_Language_Index).Config. (Lang_Index).Config.Dependency_Option,
Config_File_Switches, From_List => List,
From_List => List, In_Tree => In_Tree);
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 List := Element.Value.Values;
(Current_Language_Index).Config.Config_Body :=
Arr_Element.Value.Value;
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 Put (Into_List =>
-- (<language>) In_Tree.Languages_Data.Table
(Lang_Index).Config.Compute_Dependency,
From_List => List,
In_Tree => In_Tree);
In_Tree.Languages_Data.Table when Name_Include_Switches =>
(Current_Language_Index)
.Config.Config_Body_Pattern :=
Arr_Element.Value.Value;
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 if List = Nil_String then
(Current_Language_Index).Config.Config_Spec := Error_Msg
Arr_Element.Value.Value; (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 when Name_Include_Path =>
-- (<language>)
In_Tree.Languages_Data.Table -- Attribute Include_Path (<language>)
(Current_Language_Index)
.Config.Config_Spec_Pattern := In_Tree.Languages_Data.Table
Arr_Element.Value.Value; (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 In_Tree.Languages_Data.Table
(Current_Language_Index) (Lang_Index).Config.Include_Path_File :=
.Config.Config_File_Unique := Element.Value.Value;
Boolean'Value
(Get_Name_String (Arr_Element.Value.Value)); when Name_Driver =>
exception
when Constraint_Error => -- Attribute Driver (<language>)
Get_Name_String (Element.Value.Value);
if Name_Len = 0 then
Error_Msg Error_Msg
(Project, In_Tree, (Project,
"illegal value gor Config_File_Unique", In_Tree,
Arr_Element.Value.Location); "compiler driver name cannot be empty",
end; Element.Value.Location);
end if;
when others => In_Tree.Languages_Data.Table
null; (Lang_Index).Config.Compiler_Driver :=
end case; 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; end if;
Arr_Elmt_Id := Arr_Element.Next; Attribute_Id := Attribute.Next;
end loop; 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 loop;
end if; end Process_Packages;
-- Comment needed here ??? ---------------------------------------------
-- Process_Project_Level_Simple_Attributes --
---------------------------------------------
if Binder_Pkg /= No_Package then procedure Process_Project_Level_Simple_Attributes is
Element := In_Tree.Packages.Table (Binder_Pkg); Attribute_Id : Variable_Id;
Arrays := Element.Decl.Arrays; Attribute : Variable;
while Arrays /= No_Array loop List : String_List_Id;
Current_Array := In_Tree.Arrays.Table (Arrays);
Arr_Elmt_Id := Current_Array.Value; begin
while Arr_Elmt_Id /= No_Array_Element loop -- Process non associated array attribute at project level
Arr_Element := In_Tree.Array_Elements.Table (Arr_Elmt_Id);
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 if not Attribute.Value.Default then
case Current_Array.Name is if Attribute.Name = Name_Library_Builder then
when Name_Driver =>
-- Attribute Driver (<language>) -- Attribute Library_Builder: the application to invoke
-- to build libraries.
In_Tree.Languages_Data.Table Data.Config.Library_Builder :=
(Current_Language_Index).Config.Binder_Driver := Path_Name_Type (Attribute.Value.Value);
File_Name_Type (Arr_Element.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 List := Attribute.Value.Values;
(Current_Language_Index).Config.Objects_Path :=
Arr_Element.Value.Value; 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 In_Tree.Languages_Data.Table
(Current_Language_Index).Config.Objects_Path_File := (Lang_Index).Config.Toolchain_Description :=
Arr_Element.Value.Value; Element.Value.Value;
when Name_Prefix => when Name_Toolchain_Version =>
-- Attribute Prefix (<language>) -- Attribute Toolchain_Version (<language>)
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Current_Language_Index).Config.Binder_Prefix := (Lang_Index).Config.Toolchain_Version :=
Arr_Element.Value.Value; Element.Value.Value;
when others => when others =>
null; null;
end case; end case;
end if; end if;
Arr_Elmt_Id := Arr_Element.Next; Element_Id := Element.Next;
end loop; end loop;
Arrays := Current_Array.Next; Current_Array_Id := Current_Array.Next;
end loop; 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; 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; end Check_Configuration;
---------------------- ----------------------
...@@ -2840,7 +3590,7 @@ package body Prj.Nmsc is ...@@ -2840,7 +3590,7 @@ package body Prj.Nmsc is
if Data.Library then if Data.Library then
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Support_For_Libraries := In_Tree.Config.Lib_Support; Support_For_Libraries := Data.Config.Lib_Support;
else else
Support_For_Libraries := MLib.Tgt.Support_For_Libraries; Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
...@@ -3325,11 +4075,16 @@ package body Prj.Nmsc is ...@@ -3325,11 +4075,16 @@ package body Prj.Nmsc is
Data : in out Project_Data) Data : in out Project_Data)
is is
Languages : Variable_Value := Nil_Variable_Value; Languages : Variable_Value := Nil_Variable_Value;
Lang : Language_Index; Def_Lang : Variable_Value := Nil_Variable_Value;
Def_Lang_Id : Name_Id;
begin begin
Data.First_Language_Processing := No_Language_Index;
Languages := Languages :=
Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree); 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.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String; Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
...@@ -3360,7 +4115,7 @@ package body Prj.Nmsc is ...@@ -3360,7 +4115,7 @@ package body Prj.Nmsc is
Data.Other_Sources_Present := False; Data.Other_Sources_Present := False;
elsif In_Tree.Default_Language = No_Name then elsif Def_Lang.Default then
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
...@@ -3368,45 +4123,40 @@ package body Prj.Nmsc is ...@@ -3368,45 +4123,40 @@ package body Prj.Nmsc is
Data.Location); Data.Location);
else 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) := 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); Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
Data.First_Language_Processing := Data.First_Language_Processing :=
Language_Data_Table.Last (In_Tree.Languages_Data); Language_Data_Table.Last (In_Tree.Languages_Data);
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Data.First_Language_Processing) := No_Language_Data; (Data.First_Language_Processing) := No_Language_Data;
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Data.First_Language_Processing).Name := (Data.First_Language_Processing).Name := Def_Lang_Id;
In_Tree.Default_Language; Get_Name_String (Def_Lang_Id);
Get_Name_String (In_Tree.Default_Language);
Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1)); Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Data.First_Language_Processing).Display_Name := Name_Find; (Data.First_Language_Processing).Display_Name := Name_Find;
Lang := In_Tree.First_Language; if Def_Lang_Id = Name_Ada then
In_Tree.Languages_Data.Table
while Lang /= No_Language_Index loop (Data.First_Language_Processing).Config.Kind := Unit_Based;
if In_Tree.Languages_Data.Table (Lang).Name = In_Tree.Languages_Data.Table
In_Tree.Default_Language (Data.First_Language_Processing).Config.Dependency_Kind :=
then ALI_File;
In_Tree.Languages_Data.Table Data.Unit_Based_Language_Name := Name_Ada;
(Data.First_Language_Processing).Config := Data.Unit_Based_Language_Index :=
In_Tree.Languages_Data.Table (Lang).Config; Data.First_Language_Processing;
else
if In_Tree.Languages_Data.Table (Lang).Config.Kind = In_Tree.Languages_Data.Table
Unit_Based (Data.First_Language_Processing).Config.Kind := File_Based;
then In_Tree.Languages_Data.Table
Data.Unit_Based_Language_Name := (Data.First_Language_Processing).Config.Dependency_Kind :=
In_Tree.Default_Language; Makefile;
Data.Unit_Based_Language_Index := end if;
Data.First_Language_Processing;
end if;
exit;
end if;
Lang := In_Tree.Languages_Data.Table (Lang).Next;
end loop;
end if; end if;
else else
...@@ -3414,11 +4164,9 @@ package body Prj.Nmsc is ...@@ -3414,11 +4164,9 @@ package body Prj.Nmsc is
Current : String_List_Id := Languages.Values; Current : String_List_Id := Languages.Values;
Element : String_Element; Element : String_Element;
Lang_Name : Name_Id; Lang_Name : Name_Id;
Display_Lang_Name : Name_Id;
Index : Language_Index; Index : Language_Index;
Lang_Data : Language_Data; Lang_Data : Language_Data;
NL_Id : Name_List_Index := No_Name_List; NL_Id : Name_List_Index := No_Name_List;
Config : Language_Config;
begin begin
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
...@@ -3440,133 +4188,84 @@ package body Prj.Nmsc is ...@@ -3440,133 +4188,84 @@ package body Prj.Nmsc is
while Current /= Nil_String loop while Current /= Nil_String loop
Element := Element :=
In_Tree.String_Elements.Table (Current); In_Tree.String_Elements.Table (Current);
Display_Lang_Name := Element.Value;
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Lang_Name := Name_Find; 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 if NL_Id = No_Name_List then
Data.Languages := Name_List_Table.Increment_Last (In_Tree.Name_Lists);
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;
NL_Id := Name_List_Table.Last (In_Tree.Name_Lists); if Data.Languages = No_Name_List then
In_Tree.Name_Lists.Table (NL_Id) := Data.Languages :=
(Lang_Name, No_Name_List); Name_List_Table.Last (In_Tree.Name_Lists);
if Get_Mode = Ada_Only then else
Index := Language_Indexes.Get (Lang_Name); 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 In_Tree.Name_Lists.Table (NL_Id).Next :=
Add_Language_Name (Lang_Name); Name_List_Table.Last (In_Tree.Name_Lists);
Index := Last_Language_Index;
end if; end if;
Set (Index, True, Data, In_Tree); NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
Set (Language_Processing => In_Tree.Name_Lists.Table (NL_Id) :=
Default_Language_Processing_Data, (Lang_Name, No_Name_List);
For_Language => Index,
In_Project => Data,
In_Tree => In_Tree);
if Index = Ada_Language_Index then if Get_Mode = Ada_Only then
Data.Ada_Sources_Present := True; Index := Language_Indexes.Get (Lang_Name);
else if Index = No_Language_Index then
Data.Other_Sources_Present := True; Add_Language_Name (Lang_Name);
end if; Index := Last_Language_Index;
end if;
else Set (Index, True, Data, In_Tree);
Index := Data.First_Language_Processing; Set (Language_Processing =>
Default_Language_Processing_Data,
For_Language => Index,
In_Project => Data,
In_Tree => In_Tree);
while Index /= No_Language_Index loop if Index = Ada_Language_Index then
exit when Data.Ada_Sources_Present := True;
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 else
Data.Other_Sources_Present := True;
end if;
else
Language_Data_Table.Increment_Last Language_Data_Table.Increment_Last
(In_Tree.Languages_Data); (In_Tree.Languages_Data);
Index := Index :=
Language_Data_Table.Last (In_Tree.Languages_Data); Language_Data_Table.Last (In_Tree.Languages_Data);
Lang_Data.Name := Lang_Name; Lang_Data.Name := Lang_Name;
Lang_Data.Display_Name := Element.Value; Lang_Data.Display_Name := Element.Value;
Lang_Data.Next := Data.First_Language_Processing; 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; if Lang_Name = Name_Ada then
Lang_Data.Config.Kind := Unit_Based;
while Index /= No_Language_Index loop Lang_Data.Config.Dependency_Kind := ALI_File;
exit when Data.Unit_Based_Language_Name := Name_Ada;
Lang_Name = Data.Unit_Based_Language_Index := Index;
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);
else else
Config := Lang_Data.Config.Kind := File_Based;
In_Tree.Languages_Data.Table (Index).Config; Lang_Data.Config.Dependency_Kind := Makefile;
-- 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;
end if; end if;
In_Tree.Languages_Data.Table (Index) := Lang_Data;
Data.First_Language_Processing := Index;
end if; end if;
end if; end if;
...@@ -3665,7 +4364,7 @@ package body Prj.Nmsc is ...@@ -3665,7 +4364,7 @@ package body Prj.Nmsc is
begin begin
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Auto_Init_Supported := In_Tree.Config.Auto_Init_Supported; Auto_Init_Supported := Data.Config.Auto_Init_Supported;
else else
Auto_Init_Supported := Auto_Init_Supported :=
......
gcc/ada/prj-proc.adb
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- -- -- --
-- GNAT COMPILER COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
...@@ -31,7 +32,6 @@ with Prj.Attr; use Prj.Attr; ...@@ -31,7 +32,6 @@ with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext; with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc; with Prj.Nmsc; use Prj.Nmsc;
with Prj.Util; use Prj.Util;
with Sinput; use Sinput; with Sinput; use Sinput;
with Snames; with Snames;
...@@ -1195,464 +1195,27 @@ package body Prj.Proc is ...@@ -1195,464 +1195,27 @@ package body Prj.Proc is
When_No_Sources : Error_Warning := Error; When_No_Sources : Error_Warning := Error;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is 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 begin
Error_Report := Report_Error; Process_Project_Tree_Phase_1
Success := True; (In_Tree => In_Tree,
Project => Project,
if Reset_Tree then Success => Success,
-- 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 => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, 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 not In_Configuration then
Process_Project_Tree_Phase_2
if Project /= No_Project then (In_Tree => In_Tree,
Check Project => Project,
(In_Tree, Project, Follow_Links, When_No_Sources); Success => Success,
end if; From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
-- If main project is an extending all project, set the object Report_Error => Report_Error,
-- directory of all virtual extending projects to the object Follow_Links => Follow_Links,
-- directory of the main project. When_No_Sources => When_No_Sources);
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;
end if; end if;
Success :=
Total_Errors_Detected = 0
and then
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process; end Process;
------------------------------- -------------------------------
...@@ -1727,6 +1290,7 @@ package body Prj.Proc is ...@@ -1727,6 +1290,7 @@ package body Prj.Proc is
In_Tree.Packages.Table (Pkg).Decl.Packages; In_Tree.Packages.Table (Pkg).Decl.Packages;
In_Tree.Packages.Table (Pkg).Decl.Packages := In_Tree.Packages.Table (Pkg).Decl.Packages :=
New_Pkg; New_Pkg;
else else
The_New_Package.Next := The_New_Package.Next :=
In_Tree.Projects.Table (Project).Decl.Packages; In_Tree.Projects.Table (Project).Decl.Packages;
...@@ -1817,7 +1381,7 @@ package body Prj.Proc is ...@@ -1817,7 +1381,7 @@ package body Prj.Proc is
N_Variable_Declaration => N_Variable_Declaration =>
if Expression_Of (Current_Item, From_Project_Node_Tree) = if Expression_Of (Current_Item, From_Project_Node_Tree) =
Empty_Node Empty_Node
then then
-- It must be a full associative array attribute declaration -- It must be a full associative array attribute declaration
...@@ -1858,8 +1422,7 @@ package body Prj.Proc is ...@@ -1858,8 +1422,7 @@ package body Prj.Proc is
-- Last new element id created -- Last new element id created
Orig_Element : Array_Element_Id := No_Array_Element; Orig_Element : Array_Element_Id := No_Array_Element;
-- Current array element in the original associative -- Current array element in original associative array
-- array.
Next_Element : Array_Element_Id := No_Array_Element; Next_Element : Array_Element_Id := No_Array_Element;
-- Id of the array element that follows the new element. -- Id of the array element that follows the new element.
...@@ -1868,7 +1431,7 @@ package body Prj.Proc is ...@@ -1868,7 +1431,7 @@ package body Prj.Proc is
-- declared, and the array elements declared are reused. -- declared, and the array elements declared are reused.
begin begin
-- First, find if the associative array attribute already -- First find if the associative array attribute already
-- has elements declared. -- has elements declared.
if Pkg /= No_Package then if Pkg /= No_Package then
...@@ -1947,8 +1510,8 @@ package body Prj.Proc is ...@@ -1947,8 +1510,8 @@ package body Prj.Proc is
(Orig_Project).Decl.Arrays; (Orig_Project).Decl.Arrays;
else else
-- If in a package, find the package where the -- If in a package, find the package where the value
-- value is declared. -- is declared.
Orig_Package_Name := Orig_Package_Name :=
Name_Of Name_Of
...@@ -1978,8 +1541,8 @@ package body Prj.Proc is ...@@ -1978,8 +1541,8 @@ package body Prj.Proc is
-- Now look for the array -- Now look for the array
while Orig_Array /= No_Array and then while Orig_Array /= No_Array
In_Tree.Arrays.Table (Orig_Array).Name /= and then In_Tree.Arrays.Table (Orig_Array).Name /=
Current_Item_Name Current_Item_Name
loop loop
Orig_Array := In_Tree.Arrays.Table Orig_Array := In_Tree.Arrays.Table
...@@ -1992,7 +1555,6 @@ package body Prj.Proc is ...@@ -1992,7 +1555,6 @@ package body Prj.Proc is
("associative array value cannot be found", ("associative array value cannot be found",
Location_Of Location_Of
(Current_Item, From_Project_Node_Tree)); (Current_Item, From_Project_Node_Tree));
else else
Error_Report Error_Report
("associative array value cannot be found", ("associative array value cannot be found",
...@@ -2114,7 +1676,9 @@ package body Prj.Proc is ...@@ -2114,7 +1676,9 @@ package body Prj.Proc is
The_Variable : Variable_Id := No_Variable; The_Variable : Variable_Id := No_Variable;
Current_Item_Name : constant Name_Id := Current_Item_Name : constant Name_Id :=
Name_Of (Current_Item, From_Project_Node_Tree); Name_Of
(Current_Item,
From_Project_Node_Tree);
begin begin
-- Process a typed variable declaration -- Process a typed variable declaration
...@@ -2133,7 +1697,6 @@ package body Prj.Proc is ...@@ -2133,7 +1697,6 @@ package body Prj.Proc is
("no value defined for %%", ("no value defined for %%",
Location_Of Location_Of
(Current_Item, From_Project_Node_Tree)); (Current_Item, From_Project_Node_Tree));
else else
Error_Report Error_Report
("no value defined for " & ("no value defined for " &
...@@ -2143,17 +1706,17 @@ package body Prj.Proc is ...@@ -2143,17 +1706,17 @@ package body Prj.Proc is
else else
declare declare
Current_String : Project_Node_Id := Current_String : Project_Node_Id;
First_Literal_String
(String_Type_Of
(Current_Item,
From_Project_Node_Tree),
From_Project_Node_Tree);
begin begin
-- Loop through all the valid strings for the -- Loop through all the valid strings for the
-- string type and compare to the string value. -- 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 while Current_String /= Empty_Node
and then and then
String_Value_Of String_Value_Of
...@@ -2196,6 +1759,8 @@ package body Prj.Proc is ...@@ -2196,6 +1759,8 @@ package body Prj.Proc is
end if; end if;
end if; end if;
-- Comment here ???
if Kind_Of (Current_Item, From_Project_Node_Tree) /= if Kind_Of (Current_Item, From_Project_Node_Tree) /=
N_Attribute_Declaration N_Attribute_Declaration
or else or else
...@@ -2299,9 +1864,9 @@ package body Prj.Proc is ...@@ -2299,9 +1864,9 @@ package body Prj.Proc is
end if; end if;
else -- Associative array attribute
-- Associative array attribute
else
-- Get the string index -- Get the string index
Get_Name_String Get_Name_String
...@@ -2347,10 +1912,10 @@ package body Prj.Proc is ...@@ -2347,10 +1912,10 @@ package body Prj.Proc is
(The_Array).Next; (The_Array).Next;
end loop; end loop;
-- If the array cannot be found, create a new -- If the array cannot be found, create a new entry
-- entry in the list. As The_Array_Element is -- in the list. As The_Array_Element is initialized
-- initialized to No_Array_Element, a new element -- to No_Array_Element, a new element will be
-- will be created automatically later. -- created automatically later
if The_Array = No_Array then if The_Array = No_Array then
Array_Table.Increment_Last Array_Table.Increment_Last
...@@ -2385,7 +1950,7 @@ package body Prj.Proc is ...@@ -2385,7 +1950,7 @@ package body Prj.Proc is
The_Array; The_Array;
end if; end if;
-- Otherwise, initialize The_Array_Element as the -- Otherwise initialize The_Array_Element as the
-- head of the element list. -- head of the element list.
else else
...@@ -2407,9 +1972,9 @@ package body Prj.Proc is ...@@ -2407,9 +1972,9 @@ package body Prj.Proc is
(The_Array_Element).Next; (The_Array_Element).Next;
end loop; end loop;
-- If no such element were found, create a new -- If no such element were found, create a new one
-- one and insert it in the element list, with -- and insert it in the element list, with the
-- the propoer value. -- propoer value.
if The_Array_Element = No_Array_Element then if The_Array_Element = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
...@@ -2446,16 +2011,16 @@ package body Prj.Proc is ...@@ -2446,16 +2011,16 @@ package body Prj.Proc is
when N_Case_Construction => when N_Case_Construction =>
declare declare
The_Project : Project_Id := Project; The_Project : Project_Id := Project;
-- The id of the project of the case variable -- 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 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 -- The case variable
Case_Value : Name_Id := No_Name; Case_Value : Name_Id := No_Name;
-- The case variable value -- The case variable value
Case_Item : Project_Node_Id := Empty_Node; Case_Item : Project_Node_Id := Empty_Node;
...@@ -2643,6 +2208,184 @@ package body Prj.Proc is ...@@ -2643,6 +2208,184 @@ package body Prj.Proc is
end loop; end loop;
end Process_Declarative_Items; 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_Check --
--------------------- ---------------------
...@@ -2875,9 +2618,9 @@ package body Prj.Proc is ...@@ -2875,9 +2618,9 @@ package body Prj.Proc is
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => Processed_Data.Extends, Project => Processed_Data.Extends,
From_Project_Node => From_Project_Node => Extended_Project_Of
Extended_Project_Of (Declaration_Node,
(Declaration_Node, From_Project_Node_Tree), From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => Project); Extended_By => Project);
...@@ -2889,9 +2632,9 @@ package body Prj.Proc is ...@@ -2889,9 +2632,9 @@ package body Prj.Proc is
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package, Pkg => No_Package,
Item => Item => First_Declarative_Item_Of
First_Declarative_Item_Of (Declaration_Node,
(Declaration_Node, From_Project_Node_Tree)); From_Project_Node_Tree));
-- If it is an extending project, inherit all packages -- If it is an extending project, inherit all packages
-- from the extended project that are not explicitely defined -- from the extended project that are not explicitely defined
...@@ -2902,44 +2645,48 @@ package body Prj.Proc is ...@@ -2902,44 +2645,48 @@ package body Prj.Proc is
Processed_Data := In_Tree.Projects.Table (Project); Processed_Data := In_Tree.Projects.Table (Project);
declare declare
Extended_Pkg : Package_Id := Extended_Pkg : Package_Id;
In_Tree.Projects.Table Current_Pkg : Package_Id;
(Processed_Data.Extends).Decl.Packages; Element : Package_Element;
Current_Pkg : Package_Id; First : constant Package_Id :=
Element : Package_Element; Processed_Data.Decl.Packages;
First : constant Package_Id := Attribute1 : Variable_Id;
Processed_Data.Decl.Packages; Attribute2 : Variable_Id;
Attribute1 : Variable_Id; Attr_Value1 : Variable;
Attribute2 : Variable_Id;
Attr_Value1 : Variable;
Attr_Value2 : Variable; Attr_Value2 : Variable;
begin begin
Extended_Pkg :=
In_Tree.Projects.Table
(Processed_Data.Extends).Decl.Packages;
while Extended_Pkg /= No_Package loop while Extended_Pkg /= No_Package loop
Element := Element :=
In_Tree.Packages.Table (Extended_Pkg); In_Tree.Packages.Table (Extended_Pkg);
Current_Pkg := First; Current_Pkg := First;
while Current_Pkg /= No_Package
and then In_Tree.Packages.Table (Current_Pkg).Name /=
Element.Name
loop loop
exit when Current_Pkg = No_Package Current_Pkg :=
or else In_Tree.Packages.Table In_Tree.Packages.Table (Current_Pkg).Next;
(Current_Pkg).Name = Element.Name;
Current_Pkg := In_Tree.Packages.Table
(Current_Pkg).Next;
end loop; end loop;
if Current_Pkg = No_Package then if Current_Pkg = No_Package then
Package_Table.Increment_Last Package_Table.Increment_Last
(In_Tree.Packages); (In_Tree.Packages);
Current_Pkg := Package_Table.Last Current_Pkg := Package_Table.Last (In_Tree.Packages);
(In_Tree.Packages);
In_Tree.Packages.Table (Current_Pkg) := In_Tree.Packages.Table (Current_Pkg) :=
(Name => Element.Name, (Name => Element.Name,
Decl => Element.Decl, Decl => No_Declarations,
Parent => No_Package, Parent => No_Package,
Next => Processed_Data.Decl.Packages); Next => Processed_Data.Decl.Packages);
Processed_Data.Decl.Packages := Current_Pkg; 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; end if;
Extended_Pkg := Element.Next; Extended_Pkg := Element.Next;
...@@ -2966,7 +2713,6 @@ package body Prj.Proc is ...@@ -2966,7 +2713,6 @@ package body Prj.Proc is
Attribute2 := Attribute2 :=
In_Tree.Projects.Table In_Tree.Projects.Table
(Processed_Data.Extends).Decl.Attributes; (Processed_Data.Extends).Decl.Attributes;
while Attribute2 /= No_Variable loop while Attribute2 /= No_Variable loop
Attr_Value2 := In_Tree.Variable_Elements. Attr_Value2 := In_Tree.Variable_Elements.
Table (Attribute2); Table (Attribute2);
......
gcc/ada/prj-proc.ads
...@@ -50,12 +50,37 @@ package Prj.Proc is ...@@ -50,12 +50,37 @@ package Prj.Proc is
-- still valid if they point to a file which is outside of the project), -- still valid if they point to a file which is outside of the project),
-- and that no directory has a name which is a valid source name. -- and that no directory has a name which is a valid source name.
-- --
-- When_No_Sources indicates what should be done when no sources -- When_No_Sources indicates what should be done when no sources are found
-- are found in a project for a specified or implied language. -- in a project for a specified or implied language.
-- --
-- When Reset_Tree is True, all the project data are removed from the -- When Reset_Tree is True, all the project data are removed from the
-- project table before processing. -- project table before processing.
-- --
-- Process is a bit of a junk name, how about Process_Project_Tree??? -- Process is a bit of a junk name, how about Process_Project_Tree???
-- The two procedures that follow are implementing procedure Process in
-- two successive phases. They are used by gprbuild/gprclean to add the
-- configuration attributes between the two phases.
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);
-- See documentation of parameters in procedure Process above
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);
-- See documentation of parameters in procedure Process above
end Prj.Proc; end Prj.Proc;
gcc/ada/prj-util.adb
...@@ -145,7 +145,8 @@ package body Prj.Util is ...@@ -145,7 +145,8 @@ package body Prj.Util is
begin begin
if Builder_Package /= No_Package then if Builder_Package /= No_Package then
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Executable_Suffix_Name := In_Tree.Config.Executable_Suffix; Executable_Suffix_Name :=
In_Tree.Projects.Table (Project).Config.Executable_Suffix;
else else
Executable_Suffix := Prj.Util.Value_Of Executable_Suffix := Prj.Util.Value_Of
...@@ -283,7 +284,8 @@ package body Prj.Util is ...@@ -283,7 +284,8 @@ package body Prj.Util is
Result : File_Name_Type; Result : File_Name_Type;
begin begin
Executable_Extension_On_Target := In_Tree.Config.Executable_Suffix; Executable_Extension_On_Target :=
In_Tree.Projects.Table (Project).Config.Executable_Suffix;
Result := Executable_Name (Name_Find); Result := Executable_Name (Name_Find);
Executable_Extension_On_Target := Saved_EEOT; Executable_Extension_On_Target := Saved_EEOT;
return Result; return Result;
......
gcc/ada/prj.adb
...@@ -358,15 +358,6 @@ package body Prj is ...@@ -358,15 +358,6 @@ package body Prj is
return Default_Ada_Spec_Suffix_Id; return Default_Ada_Spec_Suffix_Id;
end Default_Ada_Spec_Suffix; end Default_Ada_Spec_Suffix;
----------------------
-- Default_Language --
----------------------
function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id is
begin
return In_Tree.Default_Language;
end Default_Language;
--------------------------- ---------------------------
-- Delete_All_Temp_Files -- -- Delete_All_Temp_Files --
--------------------------- ---------------------------
...@@ -454,10 +445,6 @@ package body Prj is ...@@ -454,10 +445,6 @@ package body Prj is
Value := Project_Empty; Value := Project_Empty;
Value.Naming := Tree.Private_Part.Default_Naming; Value.Naming := Tree.Private_Part.Default_Naming;
if Current_Mode = Multi_Language then
Value.Config := Tree.Config;
end if;
return Value; return Value;
end Empty_Project; end Empty_Project;
......
gcc/ada/prj.ads
...@@ -298,8 +298,6 @@ package Prj is ...@@ -298,8 +298,6 @@ package Prj is
Next : Name_List_Index := No_Name_List; Next : Name_List_Index := No_Name_List;
end record; end record;
function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id;
package Name_List_Table is new GNAT.Dynamic_Tables package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node, (Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index, Table_Index_Type => Name_List_Index,
...@@ -363,12 +361,9 @@ package Prj is ...@@ -363,12 +361,9 @@ package Prj is
Compiler_Driver_Path : String_Access := null; Compiler_Driver_Path : String_Access := null;
-- The path name of the executable for the compiler of the language -- The path name of the executable for the compiler of the language
Compiler_Min_Options : Name_List_Index := No_Name_List; Compiler_Required_Switches : Name_List_Index := No_Name_List;
-- The minimum options for the compiler of the language. Specified -- The list of switches that are required as a minimum to invoke the
-- in the configuration as Compiler'Switches (<language>). -- compiler driver.
Min_Compiler_Options : String_List_Access := null;
-- The minimum options as an argument list
Compilation_PIC_Option : Name_List_Index := No_Name_List; Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for -- The option(s) to compile a source in Position Independent Code for
...@@ -407,7 +402,7 @@ package Prj is ...@@ -407,7 +402,7 @@ package Prj is
Runtime_Project : Path_Name_Type := No_Path; Runtime_Project : Path_Name_Type := No_Path;
Binder_Driver : File_Name_Type := No_File; Binder_Driver : File_Name_Type := No_File;
Binder_Driver_Path : Path_Name_Type := No_Path; Binder_Driver_Path : Path_Name_Type := No_Path;
Binder_Min_Options : Name_List_Index := No_Name_List; Binder_Required_Switches : Name_List_Index := No_Name_List;
Binder_Prefix : Name_Id := No_Name; Binder_Prefix : Name_Id := No_Name;
Toolchain_Version : Name_Id := No_Name; Toolchain_Version : Name_Id := No_Name;
Toolchain_Description : Name_Id := No_Name; Toolchain_Description : Name_Id := No_Name;
...@@ -416,39 +411,38 @@ package Prj is ...@@ -416,39 +411,38 @@ package Prj is
end record; end record;
No_Language_Config : constant Language_Config := No_Language_Config : constant Language_Config :=
(Kind => File_Based, (Kind => File_Based,
Naming_Data => No_Lang_Naming_Data, Naming_Data => No_Lang_Naming_Data,
Compiler_Driver => No_File, Compiler_Driver => No_File,
Compiler_Driver_Path => null, Compiler_Driver_Path => null,
Compiler_Min_Options => No_Name_List, Compiler_Required_Switches => No_Name_List,
Min_Compiler_Options => null, Compilation_PIC_Option => No_Name_List,
Compilation_PIC_Option => No_Name_List, Mapping_File_Switches => No_Name_List,
Mapping_File_Switches => No_Name_List, Mapping_Spec_Suffix => No_File,
Mapping_Spec_Suffix => No_File, Mapping_Body_Suffix => No_File,
Mapping_Body_Suffix => No_File, Config_File_Switches => No_Name_List,
Config_File_Switches => No_Name_List, Dependency_Kind => Makefile,
Dependency_Kind => Makefile, Dependency_Option => No_Name_List,
Dependency_Option => No_Name_List, Compute_Dependency => No_Name_List,
Compute_Dependency => No_Name_List, Include_Option => No_Name_List,
Include_Option => No_Name_List, Include_Path => No_Name,
Include_Path => No_Name, Include_Path_File => No_Name,
Include_Path_File => No_Name, Objects_Path => No_Name,
Objects_Path => No_Name, Objects_Path_File => No_Name,
Objects_Path_File => No_Name, Config_Body => No_Name,
Config_Body => No_Name, Config_Spec => No_Name,
Config_Spec => No_Name, Config_Body_Pattern => No_Name,
Config_Body_Pattern => No_Name, Config_Spec_Pattern => No_Name,
Config_Spec_Pattern => No_Name, Config_File_Unique => False,
Config_File_Unique => False, Runtime_Project => No_Path,
Runtime_Project => No_Path, Binder_Driver => No_File,
Binder_Driver => No_File, Binder_Driver_Path => No_Path,
Binder_Driver_Path => No_Path, Binder_Required_Switches => No_Name_List,
Binder_Min_Options => No_Name_List, Binder_Prefix => No_Name,
Binder_Prefix => No_Name, Toolchain_Version => No_Name,
Toolchain_Version => No_Name, Toolchain_Description => No_Name,
Toolchain_Description => No_Name, PIC_Option => No_Name,
PIC_Option => No_Name, Objects_Generated => True);
Objects_Generated => True);
type Language_Data is record type Language_Data is record
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
...@@ -1390,14 +1384,6 @@ package Prj is ...@@ -1390,14 +1384,6 @@ package Prj is
type Project_Tree_Data is type Project_Tree_Data is
record record
-- General
Default_Language : Name_Id := No_Name;
-- The name of the language of the sources of a project, when
-- attribute Languages is not specified.
Config : Project_Configuration;
-- Languages and sources of the project -- Languages and sources of the project
First_Language : Language_Index := No_Language_Index; First_Language : Language_Index := No_Language_Index;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment