From a70f5d823abaf5ff25c7ef7f167a40c08889f698 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Wed, 26 Sep 2007 12:45:15 +0200 Subject: [PATCH] makeutl.ads (Main_Config_Project): Moved to gpr_util.ads 2007-09-26 Vincent Celier * 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 () 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 --- gcc/ada/makeutl.ads | 3 - gcc/ada/prj-attr.adb | 2 + gcc/ada/prj-nmsc.adb | 1461 +++++++++++++++++++++++++++++++----------- gcc/ada/prj-proc.adb | 766 ++++++++-------------- gcc/ada/prj-proc.ads | 29 +- gcc/ada/prj-util.adb | 6 +- gcc/ada/prj.adb | 13 - gcc/ada/prj.ads | 86 ++- 8 files changed, 1405 insertions(+), 961 deletions(-) diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 3e1f1417312..b03783c73c7 100644 --- a/gcc/ada/makeutl.ads +++ b/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; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 60c150e418d..a833de6ae9b 100644 --- a/gcc/ada/prj-attr.adb +++ b/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#" & diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index a9746894e07..67d397570c7 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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 () + 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 () + 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 () + -- Attribute Driver () - 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 () + when Name_Prefix => - In_Tree.Languages_Data.Table - (Current_Language_Index).Config.Include_Path_File := - Arr_Element.Value.Value; + -- Attribute Prefix () - when Name_Driver => + In_Tree.Languages_Data.Table + (Lang_Index).Config.Binder_Prefix := + Element.Value.Value; - -- Attribute Driver () + when Name_Objects_Path => - Get_Name_String (Arr_Element.Value.Value); + -- Attribute Objects_Path () - 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 () - -- Attribute Minimum_Compiler_Options () + 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 () + --------------------- + -- 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 () + -- 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 () + 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 () + -- 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 () + -- Attribute Dependency_Switches () - 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 () + -- Attribute Dependency_Driver () - 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 - -- () + 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 () - -- Attribute Config_Spec_File_Name () + 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 - -- () + when Name_Include_Path => - In_Tree.Languages_Data.Table - (Current_Language_Index) - .Config.Config_Spec_Pattern := - Arr_Element.Value.Value; + -- Attribute Include_Path () + + 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 () + -- Attribute Include_Path_File () - 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 () + + 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 () + + 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 () + + 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 () + + 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 () + + 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 () + + 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 () + + In_Tree.Languages_Data.Table + (Lang_Index).Config.Objects_Path := + Element.Value.Value; + + when Name_Objects_Path_File => + + -- Attribute Objects_Path_File () + + 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 () + + 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 + -- () + + 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 () + + 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 + -- () + + In_Tree.Languages_Data.Table + (Lang_Index).Config.Config_Spec_Pattern := + Element.Value.Value; + + when Name_Config_File_Unique => + + -- Attribute Config_File_Unique () + + 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 () + + 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 () + + 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 () + -- 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 () + -- 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 () + 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 () 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 () + -- Attribute Toolchain_Version () 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 := diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index b56d972a121..f6a161039fb 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -1,4 +1,5 @@ ------------------------------------------------------------------------------ + -- -- -- 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); diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index b7eec0211ae..b9f821520bd 100644 --- a/gcc/ada/prj-proc.ads +++ b/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; diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index b6086ad163b..1917bd22502 100644 --- a/gcc/ada/prj-util.adb +++ b/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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index cb83d2992e7..5b0ebbb8ebd 100644 --- a/gcc/ada/prj.adb +++ b/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; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index bf82c17f597..c0c936e0477 100644 --- a/gcc/ada/prj.ads +++ b/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 (). - - 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; -- 2.30.2