diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 302 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 42 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 2 |
7 files changed, 124 insertions, 247 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a1b8ad128ed..235cf5386c6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2009-04-22 Emmanuel Briot <briot@adacore.com> + + * make.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj.adb, + prj.ads (Create_Mapping_File): merge the two versions for Ada_Only and + Multi_Language modes, to avoid code duplication. + (Project_Data.Include_Language): Removed. + 2009-04-22 Vincent Celier <celier@adacore.com> * tempdir.adb (Create_Temp_File): Add a diagnostic in verbose mode when diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 559baeb0d46..168e4f3643d 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6380,7 +6380,7 @@ package body Make is Library_Paths.Table (Index).all); end loop; - -- One switch for the standard GNAT library dir. + -- One switch for the standard GNAT library dir Linker_Switches.Increment_Last; Linker_Switches.Table @@ -6809,9 +6809,11 @@ package body Make is if Project /= No_Project then Prj.Env.Create_Mapping_File - (Project, Project_Tree, - The_Mapping_File_Names - (Project, Last_Mapping_File_Names (Project))); + (Project, + In_Tree => Project_Tree, + Language => No_Name, + Name => The_Mapping_File_Names + (Project, Last_Mapping_File_Names (Project))); -- Otherwise, just create an empty file diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 3be45314142..3b0b1e51e00 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -57,14 +57,9 @@ package body Prj.Env is -- platforms, except on VMS where the logical names are deassigned, thus -- avoiding the pollution of the environment of the caller. - Default_Naming : constant Naming_Id := Naming_Table.First; - + Default_Naming : constant Naming_Id := Naming_Table.First; Fill_Mapping_File : Boolean := True; - type Project_Flags is array (Project_Id range <>) of Boolean; - -- A Boolean array type used in Create_Mapping_File to select the projects - -- in the closure of a specific project. - ----------------------- -- Local Subprograms -- ----------------------- @@ -1041,22 +1036,24 @@ package body Prj.Env is ------------------------- procedure Create_Mapping_File - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Name : out Path_Name_Type) + (Project : Project_Id; + Language : Name_Id := No_Name; + In_Tree : Project_Tree_Ref; + Name : out Path_Name_Type) is - File : File_Descriptor := Invalid_FD; - The_Unit_Data : Unit_Data; - Data : File_Name_Data; - + File : File_Descriptor := Invalid_FD; Status : Boolean; - -- For call to Close - Present : Project_Flags - (No_Project .. Project_Table.Last (In_Tree.Projects)) := - (others => False); + Present : array (No_Project .. Project_Table.Last (In_Tree.Projects)) + of Boolean := (others => False); -- For each project in the closure of Project, the corresponding flag - -- will be set to True; + -- will be set to True. + + Source : Source_Id; + Src_Data : Source_Data; + Suffix : File_Name_Type; + The_Unit_Data : Unit_Data; + Data : File_Name_Data; procedure Put_Name_Buffer; -- Put the line contained in the Name_Buffer in the mapping file @@ -1082,7 +1079,7 @@ package body Prj.Env is Last := Write (File, Name_Buffer (1)'Address, Name_Len); if Last /= Name_Len then - Prj.Com.Fail ("Disk full"); + Prj.Com.Fail ("Disk full, cannot write mapping file"); end if; end Put_Name_Buffer; @@ -1116,7 +1113,6 @@ package body Prj.Env is Get_Name_String (Data.Path.Name); Put_Name_Buffer; - end Put_Data; -------------------- @@ -1128,32 +1124,21 @@ package body Prj.Env is Proj : Project_Id; begin - -- Nothing to do for non existent project or project that has - -- already been flagged. - - if Prj = No_Project or else Present (Prj) then - return; - end if; - - -- Flag the current project - - Present (Prj) := True; - Imported := - In_Tree.Projects.Table (Prj).Imported_Projects; - - -- Call itself for each project directly imported + -- Nothing to do for non existent project or project that has already + -- been flagged. - while Imported /= Empty_Project_List loop - Proj := - In_Tree.Project_Lists.Table (Imported).Project; - Imported := - In_Tree.Project_Lists.Table (Imported).Next; - Recursive_Flag (Proj); - end loop; + if Prj /= No_Project and then not Present (Prj) then + Present (Prj) := True; - -- Call itself for an eventual project being extended + Imported := In_Tree.Projects.Table (Prj).Imported_Projects; + while Imported /= Empty_Project_List loop + Proj := In_Tree.Project_Lists.Table (Imported).Project; + Imported := In_Tree.Project_Lists.Table (Imported).Next; + Recursive_Flag (Proj); + end loop; - Recursive_Flag (In_Tree.Projects.Table (Prj).Extends); + Recursive_Flag (In_Tree.Projects.Table (Prj).Extends); + end if; end Recursive_Flag; -- Start of processing for Create_Mapping_File @@ -1180,201 +1165,90 @@ package body Prj.Env is end if; end if; - if Fill_Mapping_File then + if Language = No_Name then + if Fill_Mapping_File then + for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop + The_Unit_Data := In_Tree.Units.Table (Unit); - -- For all units in table Units + -- Case of unit has a valid name - for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop - The_Unit_Data := In_Tree.Units.Table (Unit); + if The_Unit_Data.Name /= No_Name then + Data := The_Unit_Data.File_Names (Specification); - -- If the unit has a valid name + -- If there is a spec, put it mapping in the file if it is + -- from a project in the closure of Project. - if The_Unit_Data.Name /= No_Name then - Data := The_Unit_Data.File_Names (Specification); - - -- If there is a spec, put it mapping in the file if it is - -- from a project in the closure of Project. - - if Data.Name /= No_File and then Present (Data.Project) then - Put_Data (Spec => True); - end if; + if Data.Name /= No_File and then Present (Data.Project) then + Put_Data (Spec => True); + end if; - Data := The_Unit_Data.File_Names (Body_Part); + Data := The_Unit_Data.File_Names (Body_Part); - -- If there is a body (or subunit) put its mapping in the file - -- if it is from a project in the closure of Project. + -- If there is a body (or subunit) put its mapping in the + -- file if it is from a project in the closure of Project. - if Data.Name /= No_File and then Present (Data.Project) then - Put_Data (Spec => False); + if Data.Name /= No_File and then Present (Data.Project) then + Put_Data (Spec => False); + end if; end if; - - end if; - end loop; - end if; - - GNAT.OS_Lib.Close (File, Status); - - if not Status then - Prj.Com.Fail ("disk full"); - end if; - end Create_Mapping_File; - - procedure Create_Mapping_File - (Project : Project_Id; - Language : Name_Id; - In_Tree : Project_Tree_Ref; - Name : out Path_Name_Type) - is - File : File_Descriptor := Invalid_FD; - - Status : Boolean; - -- For call to Close - - Present : Project_Flags - (No_Project .. Project_Table.Last (In_Tree.Projects)) := - (others => False); - -- For each project in the closure of Project, the corresponding flag - -- will be set to True. - - Source : Source_Id; - Src_Data : Source_Data; - Suffix : File_Name_Type; - - procedure Put_Name_Buffer; - -- Put the line contained in the Name_Buffer in the mapping file - - procedure Recursive_Flag (Prj : Project_Id); - -- Set the flags corresponding to Prj, the projects it imports - -- (directly or indirectly) or extends to True. Call itself recursively. - - --------- - -- Put -- - --------- - - procedure Put_Name_Buffer is - Last : Natural; - - begin - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ASCII.LF; - Last := Write (File, Name_Buffer (1)'Address, Name_Len); - - if Last /= Name_Len then - Prj.Com.Fail ("Disk full"); - end if; - end Put_Name_Buffer; - - -------------------- - -- Recursive_Flag -- - -------------------- - - procedure Recursive_Flag (Prj : Project_Id) is - Imported : Project_List; - Proj : Project_Id; - - begin - -- Nothing to do for non existent project or project that has already - -- been flagged. - - if Prj = No_Project or else Present (Prj) then - return; + end loop; end if; - -- Flag the current project - - Present (Prj) := True; - Imported := - In_Tree.Projects.Table (Prj).Imported_Projects; - - -- Call itself for each project directly imported - - while Imported /= Empty_Project_List loop - Proj := - In_Tree.Project_Lists.Table (Imported).Project; - Imported := - In_Tree.Project_Lists.Table (Imported).Next; - Recursive_Flag (Proj); - end loop; - - -- Call itself for an eventual project being extended - - Recursive_Flag (In_Tree.Projects.Table (Prj).Extends); - end Recursive_Flag; - - -- Start of processing for Create_Mapping_File - - begin - -- Flag the necessary projects - - Recursive_Flag (Project); - - -- Create the temporary file - - Tempdir.Create_Temp_File (File, Name => Name); - - if File = Invalid_FD then - Prj.Com.Fail ("unable to create temporary mapping file"); - + -- If language is defined else - Record_Temp_File (Name); - - if Opt.Verbose_Mode then - Write_Str ("Creating temp mapping file """); - Write_Str (Get_Name_String (Name)); - Write_Line (""""); - end if; - end if; - - -- For all source of the Language of all projects in the closure + -- For all source of the Language of all projects in the closure + + for Proj in Present'Range loop + if Present (Proj) then + Source := In_Tree.Projects.Table (Proj).First_Source; + while Source /= No_Source loop + Src_Data := In_Tree.Sources.Table (Source); + + if In_Tree.Languages_Data.Table + (In_Tree.Sources.Table (Source).Language).Name = Language + and then not Src_Data.Locally_Removed + and then Src_Data.Replaced_By = No_Source + and then Src_Data.Path.Name /= No_Path + then + if Src_Data.Unit /= No_Name then + Get_Name_String (Src_Data.Unit); - for Proj in Present'Range loop - if Present (Proj) then - Source := In_Tree.Projects.Table (Proj).First_Source; - while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + if Src_Data.Kind = Spec then + Suffix := + In_Tree.Languages_Data.Table + (Src_Data.Language).Config.Mapping_Spec_Suffix; + else + Suffix := + In_Tree.Languages_Data.Table + (Src_Data.Language).Config.Mapping_Body_Suffix; + end if; - if In_Tree.Languages_Data.Table - (In_Tree.Sources.Table (Source).Language).Name = Language - and then not Src_Data.Locally_Removed - and then Src_Data.Replaced_By = No_Source - and then Src_Data.Path.Name /= No_Path - then - if Src_Data.Unit /= No_Name then - Get_Name_String (Src_Data.Unit); + if Suffix /= No_File then + Add_Str_To_Name_Buffer (Get_Name_String (Suffix)); + end if; - if Src_Data.Kind = Spec then - Suffix := - In_Tree.Languages_Data.Table - (Src_Data.Language).Config.Mapping_Spec_Suffix; - else - Suffix := - In_Tree.Languages_Data.Table - (Src_Data.Language).Config.Mapping_Body_Suffix; + Put_Name_Buffer; end if; - if Suffix /= No_File then - Add_Str_To_Name_Buffer (Get_Name_String (Suffix)); - end if; + Get_Name_String (Src_Data.File); + Put_Name_Buffer; + Get_Name_String (Src_Data.Path.Name); Put_Name_Buffer; end if; - Get_Name_String (Src_Data.File); - Put_Name_Buffer; - - Get_Name_String (Src_Data.Path.Name); - Put_Name_Buffer; - end if; - - Source := Src_Data.Next_In_Project; - end loop; - end if; - end loop; + Source := Src_Data.Next_In_Project; + end loop; + end if; + end loop; + end if; GNAT.OS_Lib.Close (File, Status); if not Status then - Prj.Com.Fail ("disk full"); + Prj.Com.Fail ("disk full, could not create mapping file"); + -- Do we know this is disk full? Or could it be e.g. a protection + -- problem of some kind preventing creation of the file ??? end if; end Create_Mapping_File; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index b4aa8e4fa5e..dbce7b648ca 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -41,30 +41,27 @@ package Prj.Env is -- corresponding to a source. procedure Create_Mapping_File - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Name : out Path_Name_Type); - -- Create a temporary mapping file for project Project. For each unit - -- in the closure of immediate sources of Project, put the mapping of - -- its spec and or body to its file name and path name in this file. - - procedure Create_Mapping_File (Project : Project_Id; - Language : Name_Id; + Language : Name_Id := No_Name; In_Tree : Project_Tree_Ref; Name : out Path_Name_Type); -- Create a temporary mapping file for project Project. For each source or -- template of Language in the Project, put the mapping of its file -- name and path name in this file. -- + -- This function either looks at all the source files for the specified + -- language in the project, or if Language is set to No_Name, at all + -- units in the project. + -- -- Implementation note: we pass a language name, not a language_index here, -- since the latter would have to match exactly the index of that language -- for the specified project, and that is not information available in - -- buildgpr.adb + -- buildgpr.adb. procedure Set_Mapping_File_Initial_State_To_Empty; - -- When creating a mapping file, create an empty map. This case occurs - -- when run time source files are found in the project files. + -- When creating a mapping file, create an empty map. This case occurs when + -- run time source files are found in the project files. This only applies + -- to the Ada_Only mode. procedure Create_Config_Pragmas_File (For_Project : Project_Id; @@ -97,11 +94,11 @@ package Prj.Env is (Project : Project_Id; In_Tree : Project_Tree_Ref; Recursive : Boolean) return String; - -- Get the source search path of a Project file. If Recursive it True, - -- get all the source directories of the imported and modified project - -- files (recursively). If Recursive is False, just get the path for the - -- source directories of Project. Note: the resulting String may be empty - -- if there is no source directory in the project file. + -- Get the source search path of a Project file. If Recursive it True, get + -- all the source directories of the imported and modified project files + -- (recursively). If Recursive is False, just get the path for the source + -- directories of Project. Note: the resulting String may be empty if there + -- is no source directory in the project file. function Ada_Objects_Path (Project : Project_Id; @@ -115,18 +112,17 @@ package Prj.Env is (Project : Project_Id; In_Tree : Project_Tree_Ref; Including_Libraries : Boolean); - -- Set the env vars for additional project path files, after + -- Set the environment variables for additional project path files, after -- creating the path files if necessary. procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref); - -- Delete all temporary path files that have been created by - -- calls to Set_Ada_Paths. + -- Delete all temporary path files that have been created by Set_Ada_Paths function Path_Name_Of_Library_Unit_Body (Name : String; Project : Project_Id; In_Tree : Project_Tree_Ref) return String; - -- Returns the Path of a library unit + -- Returns the path of a library unit function File_Name_Of_Library_Unit_Body (Name : String; @@ -169,8 +165,8 @@ package Prj.Env is procedure For_All_Source_Dirs (Project : Project_Id; In_Tree : Project_Tree_Ref); - -- Iterate through all the source directories of a project, including - -- those of imported or modified projects. + -- Iterate through all the source directories of a project, including those + -- of imported or modified projects. generic with procedure Action (Path : String); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 4b282243b3b..daff8ef30ee 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -72,9 +72,10 @@ package body Prj.Nmsc is Except : Boolean := False; Found : Boolean := False; end record; - -- Information about file names found in string list attribute - -- Source_Files or in a source list file, stored in hash table + -- Information about file names found in string list attribute: + -- Source_Files or in a source list file, stored in hash table. -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. + -- Except is set to True if source is a naming exception in the project. No_Name_Location : constant Name_Location := (Name => No_File, @@ -3264,7 +3265,7 @@ package body Prj.Nmsc is Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix)); - -- We'll need the dot replacement below, so compute it now. + -- We'll need the dot replacement below, so compute it now Check_Common (Dot_Replacement => Data.Naming.Dot_Replacement, diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index db6ea7f81fa..966f40870db 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -116,7 +116,6 @@ package body Prj is Imported_Directories_Switches => null, Include_Path => null, Include_Data_Set => False, - Include_Language => No_Language_Index, Source_Dirs => Nil_String, Known_Order_Of_Source_Dirs => True, Object_Directory => No_Path_Information, diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 760a076f6db..10d023b8e65 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1178,8 +1178,6 @@ package Prj is -- The list of languages of the sources of this project -- mode: Ada_Only - Include_Language : Language_Index := No_Language_Index; - First_Language_Processing : Language_Index := No_Language_Index; -- First index of the language data in the project. -- This is an index into the project_tree_data.languages_data |
