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
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
-- The project tree
Main_Config_Project : Project_Id;
-- The project id of the main configuration project
procedure Add
(Option : String_Access;
To : in out String_List_Access;
......
gcc/ada/prj-attr.adb
......@@ -156,6 +156,7 @@ package body Prj.Attr is
-- Configuration - Compiling
"Sadriver#" &
"Larequired_switches#" &
"Lapic_option#" &
-- Configuration - Mapping files
......@@ -208,6 +209,7 @@ package body Prj.Attr is
-- Configuration - Binding
"Sadriver#" &
"Larequired_switches#" &
"Saprefix#" &
"Saobjects_path#" &
"Saobjects_path_file#" &
......
gcc/ada/prj-nmsc.adb
......@@ -939,368 +939,1118 @@ package body Prj.Nmsc is
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;
----------------------
......@@ -2840,7 +3590,7 @@ package body Prj.Nmsc is
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;
......@@ -3325,11 +4075,16 @@ package body Prj.Nmsc is
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;
......@@ -3360,7 +4115,7 @@ package body Prj.Nmsc is
Data.Other_Sources_Present := False;
elsif In_Tree.Default_Language = No_Name then
elsif Def_Lang.Default then
Error_Msg
(Project,
In_Tree,
......@@ -3368,45 +4123,40 @@ package body Prj.Nmsc is
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
......@@ -3414,11 +4164,9 @@ package body Prj.Nmsc is
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
......@@ -3440,133 +4188,84 @@ package body Prj.Nmsc is
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;
......@@ -3665,7 +4364,7 @@ package body Prj.Nmsc is
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 :=
......
gcc/ada/prj-proc.adb
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
......@@ -31,7 +32,6 @@ with Prj.Attr; use Prj.Attr;
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;
......@@ -1195,464 +1195,27 @@ package body Prj.Proc is
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;
-------------------------------
......@@ -1727,6 +1290,7 @@ package body Prj.Proc is
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;
......@@ -1817,7 +1381,7 @@ package body Prj.Proc is
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
......@@ -1858,8 +1422,7 @@ package body Prj.Proc is
-- 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.
......@@ -1868,7 +1431,7 @@ package body Prj.Proc is
-- 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
......@@ -1947,8 +1510,8 @@ package body Prj.Proc is
(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
......@@ -1978,8 +1541,8 @@ package body Prj.Proc is
-- 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
......@@ -1992,7 +1555,6 @@ package body Prj.Proc is
("associative array value cannot be found",
Location_Of
(Current_Item, From_Project_Node_Tree));
else
Error_Report
("associative array value cannot be found",
......@@ -2114,7 +1676,9 @@ package body Prj.Proc is
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
......@@ -2133,7 +1697,6 @@ package body Prj.Proc is
("no value defined for %%",
Location_Of
(Current_Item, From_Project_Node_Tree));
else
Error_Report
("no value defined for " &
......@@ -2143,17 +1706,17 @@ package body Prj.Proc is
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
......@@ -2196,6 +1759,8 @@ package body Prj.Proc is
end if;
end if;
-- Comment here ???
if Kind_Of (Current_Item, From_Project_Node_Tree) /=
N_Attribute_Declaration
or else
......@@ -2299,9 +1864,9 @@ package body Prj.Proc is
end if;
else
-- Associative array attribute
-- Associative array attribute
else
-- Get the string index
Get_Name_String
......@@ -2347,10 +1912,10 @@ package body Prj.Proc is
(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
......@@ -2385,7 +1950,7 @@ package body Prj.Proc is
The_Array;
end if;
-- Otherwise, initialize The_Array_Element as the
-- Otherwise initialize The_Array_Element as the
-- head of the element list.
else
......@@ -2407,9 +1972,9 @@ package body Prj.Proc is
(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
......@@ -2446,16 +2011,16 @@ package body Prj.Proc is
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;
......@@ -2643,6 +2208,184 @@ package body Prj.Proc is
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 --
---------------------
......@@ -2875,9 +2618,9 @@ package body Prj.Proc is
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);
......@@ -2889,9 +2632,9 @@ package body Prj.Proc is
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
......@@ -2902,44 +2645,48 @@ package body Prj.Proc is
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;
......@@ -2966,7 +2713,6 @@ package body Prj.Proc is
Attribute2 :=
In_Tree.Projects.Table
(Processed_Data.Extends).Decl.Attributes;
while Attribute2 /= No_Variable loop
Attr_Value2 := In_Tree.Variable_Elements.
Table (Attribute2);
......
gcc/ada/prj-proc.ads
......@@ -50,12 +50,37 @@ package Prj.Proc is
-- 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.
--
-- When_No_Sources indicates what should be done when no sources
-- are found in a project for a specified or implied language.
-- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language.
--
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
--
-- 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;
gcc/ada/prj-util.adb
......@@ -145,7 +145,8 @@ package body Prj.Util is
begin
if Builder_Package /= No_Package 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
Executable_Suffix := Prj.Util.Value_Of
......@@ -283,7 +284,8 @@ package body Prj.Util is
Result : File_Name_Type;
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);
Executable_Extension_On_Target := Saved_EEOT;
return Result;
......
gcc/ada/prj.adb
......@@ -358,15 +358,6 @@ package body Prj is
return Default_Ada_Spec_Suffix_Id;
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 --
---------------------------
......@@ -454,10 +445,6 @@ package body Prj is
Value := Project_Empty;
Value.Naming := Tree.Private_Part.Default_Naming;
if Current_Mode = Multi_Language then
Value.Config := Tree.Config;
end if;
return Value;
end Empty_Project;
......
gcc/ada/prj.ads
......@@ -298,8 +298,6 @@ package Prj is
Next : Name_List_Index := No_Name_List;
end record;
function Default_Language (In_Tree : Project_Tree_Ref) return Name_Id;
package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index,
......@@ -363,12 +361,9 @@ package Prj is
Compiler_Driver_Path : String_Access := null;
-- The path name of the executable for the compiler of the language
Compiler_Min_Options : Name_List_Index := No_Name_List;
-- The minimum options for the compiler of the language. Specified
-- in the configuration as Compiler'Switches (<language>).
Min_Compiler_Options : String_List_Access := null;
-- The minimum options as an argument list
Compiler_Required_Switches : Name_List_Index := No_Name_List;
-- The list of switches that are required as a minimum to invoke the
-- compiler driver.
Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for
......@@ -407,7 +402,7 @@ package Prj is
Runtime_Project : Path_Name_Type := No_Path;
Binder_Driver : File_Name_Type := No_File;
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;
Toolchain_Version : Name_Id := No_Name;
Toolchain_Description : Name_Id := No_Name;
......@@ -416,39 +411,38 @@ package Prj is
end record;
No_Language_Config : constant Language_Config :=
(Kind => File_Based,
Naming_Data => No_Lang_Naming_Data,
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Min_Options => No_Name_List,
Min_Compiler_Options => null,
Compilation_PIC_Option => No_Name_List,
Mapping_File_Switches => No_Name_List,
Mapping_Spec_Suffix => No_File,
Mapping_Body_Suffix => No_File,
Config_File_Switches => No_Name_List,
Dependency_Kind => Makefile,
Dependency_Option => No_Name_List,
Compute_Dependency => No_Name_List,
Include_Option => No_Name_List,
Include_Path => No_Name,
Include_Path_File => No_Name,
Objects_Path => No_Name,
Objects_Path_File => No_Name,
Config_Body => No_Name,
Config_Spec => No_Name,
Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name,
Config_File_Unique => False,
Runtime_Project => No_Path,
Binder_Driver => No_File,
Binder_Driver_Path => No_Path,
Binder_Min_Options => No_Name_List,
Binder_Prefix => No_Name,
Toolchain_Version => No_Name,
Toolchain_Description => No_Name,
PIC_Option => No_Name,
Objects_Generated => True);
(Kind => File_Based,
Naming_Data => No_Lang_Naming_Data,
Compiler_Driver => No_File,
Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List,
Compilation_PIC_Option => No_Name_List,
Mapping_File_Switches => No_Name_List,
Mapping_Spec_Suffix => No_File,
Mapping_Body_Suffix => No_File,
Config_File_Switches => No_Name_List,
Dependency_Kind => Makefile,
Dependency_Option => No_Name_List,
Compute_Dependency => No_Name_List,
Include_Option => No_Name_List,
Include_Path => No_Name,
Include_Path_File => No_Name,
Objects_Path => No_Name,
Objects_Path_File => No_Name,
Config_Body => No_Name,
Config_Spec => No_Name,
Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name,
Config_File_Unique => False,
Runtime_Project => No_Path,
Binder_Driver => No_File,
Binder_Driver_Path => No_Path,
Binder_Required_Switches => No_Name_List,
Binder_Prefix => No_Name,
Toolchain_Version => No_Name,
Toolchain_Description => No_Name,
PIC_Option => No_Name,
Objects_Generated => True);
type Language_Data is record
Name : Name_Id := No_Name;
......@@ -1390,14 +1384,6 @@ package Prj is
type Project_Tree_Data is
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
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