mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 01:40:39 +08:00
Code Issues Packages Projects Releases Wiki Activity

fmap.ads, [...] (Source_Data.Get_Object): Field removed, since it can be computed efficiently from the other fields.

Browse Source 
2009-06-25  Emmanuel Briot  <briot@adacore.com>

	* fmap.ads, make.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb,
	prj-env.ads (Source_Data.Get_Object): Field removed, since it can be
	computed efficiently from the other fields.
	(Object_To_Global_Archive): New subprogram
	(Create_Mapping): Remove unneeded call to Remove_Forbidden_File_Name.
	(Override_Kind): Fix handling of separates in Ada.
	(Create_Mapping_File): Remove duplicate code
	(Naming_Data.Implementation_Exception, Specification_Exception):
	field removed, since never used.
	(Naming_Data.Specs, .Bodies): field removed, since this is only
	used while processing the project and is not needed once the tree
	is in memory. This brings Naming_Data and Lang_Naming_Data
	closer (same content now, but different use still).

From-SVN: r148934
This commit is contained in:
Emmanuel Briot 2009-06-25 09:00:52 +00:00 committed by Arnaud Charlet
parent 8f2eeab7a7
commit 1d24fc5e45
8 changed files with 160 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2009-06-25 Emmanuel Briot <briot@adacore.com>
* fmap.ads, make.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb,
prj-env.ads (Source_Data.Get_Object): Field removed, since it can be
computed efficiently from the other fields.
(Object_To_Global_Archive): New subprogram
(Create_Mapping): Remove unneeded call to Remove_Forbidden_File_Name.
(Override_Kind): Fix handling of separates in Ada.
(Create_Mapping_File): Remove duplicate code
(Naming_Data.Implementation_Exception, Specification_Exception):
field removed, since never used.
(Naming_Data.Specs, .Bodies): field removed, since this is only
used while processing the project and is not needed once the tree
is in memory. This brings Naming_Data and Lang_Naming_Data
closer (same content now, but different use still).
2009-06-25 Pascal Obry <obry@adacore.com>
* sem_ch4.adb: Minor reformatting.

1
gcc/ada/fmap.ads
View File

@ -31,6 +31,7 @@
-- following:
-- For each source file, there are three lines in the mapping file:
-- Unit name with %b or %s added depending on whether it is a body or a spec
-- This line is omitted for file-based languages
-- File name
-- Path name (set to '/' if the file should be ignored in fact, ie for
-- a Locally_Removed_File in a project)

2
gcc/ada/make.adb
View File

@ -6643,7 +6643,7 @@ package body Make is
Prj.Env.Create_Mapping_File
(Project,
In_Tree => Project_Tree,
Language => No_Name,
Language => Name_Ada,
Name => Data.Mapping_File_Names
(Data.Last_Mapping_File_Names));

261
gcc/ada/prj-env.adb
View File

@ -758,10 +758,6 @@ package body Prj.Env is
if Data.Locally_Removed then
Fmap.Add_Forbidden_File_Name (Data.File);
else
-- Put back the file in case it was excluded in an extended
-- project
Fmap.Remove_Forbidden_File_Name (Data.File);
Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (Data.Unit.Name),
File_Name => Data.File,
@ -779,33 +775,18 @@ package body Prj.Env is
procedure Create_Mapping_File
(Project : Project_Id;
Language : Name_Id := No_Name;
Language : Name_Id;
In_Tree : Project_Tree_Ref;
Name : out Path_Name_Type)
is
File : File_Descriptor := Invalid_FD;
Status : Boolean;
Present : Project_Boolean_Htable.Instance;
-- For each project in the closure of Project, the corresponding flag
-- will be set to True.
Source : Source_Id;
Suffix : File_Name_Type;
Unit : Unit_Index;
Data : Source_Id;
Iter : Source_Iterator;
procedure Put_Name_Buffer;
-- Put the line contained in the Name_Buffer in the mapping file
procedure Put_Data (Spec : Boolean);
-- Put the mapping of the spec or body contained in Data in the file
-- (3 lines).
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.
procedure Process (Project : Project_Id; State : in out Integer);
-- Generate the mapping file for Project (not recursively)
---------
-- Put --
@ -819,81 +800,97 @@ package body Prj.Env is
Name_Buffer (Name_Len) := ASCII.LF;
Last := Write (File, Name_Buffer (1)'Address, Name_Len);
if Current_Verbosity = High then
Write_Str ("Mapping file: " & Name_Buffer (1 .. Name_Len));
end if;
if Last /= Name_Len then
Prj.Com.Fail ("Disk full, cannot write mapping file");
end if;
end Put_Name_Buffer;
--------------
-- Put_Data --
--------------
-------------
-- Process --
-------------
procedure Put_Data (Spec : Boolean) is
begin
-- Line with the unit name
Get_Name_String (Unit.Name);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '%';
Name_Len := Name_Len + 1;
if Spec then
Name_Buffer (Name_Len) := 's';
else
Name_Buffer (Name_Len) := 'b';
end if;
Put_Name_Buffer;
-- Line with the file name
Get_Name_String (Data.File);
Put_Name_Buffer;
-- Line with the path name
if Data.Locally_Removed then
Name_Len := 1;
Name_Buffer (1 .. Name_Len) := "/";
else
Get_Name_String (Data.Path.Name);
end if;
Put_Name_Buffer;
end Put_Data;
--------------------
-- Recursive_Flag --
--------------------
procedure Recursive_Flag (Prj : Project_Id) is
Imported : Project_List;
procedure Process (Project : Project_Id; State : in out Integer) is
pragma Unreferenced (State);
Source : Source_Id;
Suffix : File_Name_Type;
Iter : Source_Iterator;
begin
-- Nothing to do for non existent project or project that has already
-- been flagged.
Iter := For_Each_Source (In_Tree, Project, Language => Language);
if Prj /= No_Project
and then not Project_Boolean_Htable.Get (Present, Prj)
then
Project_Boolean_Htable.Set (Present, Prj, True);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
Imported := Prj.Imported_Projects;
while Imported /= null loop
Recursive_Flag (Imported.Project);
Imported := Imported.Next;
end loop;
if Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path
and then
(Source.Language.Config.Kind = File_Based
or else Source.Unit /= No_Unit_Index)
then
if Source.Unit /= No_Unit_Index then
Get_Name_String (Source.Unit.Name);
Recursive_Flag (Prj.Extends);
end if;
end Recursive_Flag;
if Get_Mode = Ada_Only then
-- ??? Mapping_Spec_Suffix could be set in the case of
-- gnatmake as well
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '%';
Name_Len := Name_Len + 1;
if Source.Kind = Spec then
Name_Buffer (Name_Len) := 's';
else
Name_Buffer (Name_Len) := 'b';
end if;
else
case Source.Kind is
when Spec =>
Suffix :=
Source.Language.Config.Mapping_Spec_Suffix;
when Impl | Sep =>
Suffix :=
Source.Language.Config.Mapping_Body_Suffix;
end case;
if Suffix /= No_File then
Add_Str_To_Name_Buffer
(Get_Name_String (Suffix));
end if;
end if;
Put_Name_Buffer;
end if;
Get_Name_String (Source.File);
Put_Name_Buffer;
if Source.Locally_Removed then
Name_Len := 1;
Name_Buffer (1) := '/';
else
Get_Name_String (Source.Path.Name);
end if;
Put_Name_Buffer;
end if;
Next (Iter);
end loop;
end Process;
procedure For_Every_Imported_Project is new
For_Every_Project_Imported (State => Integer, Action => Process);
Dummy : Integer := 0;
-- Start of processing for Create_Mapping_File
begin
-- Flag the necessary projects
Recursive_Flag (Project);
-- Create the temporary file
@ -912,103 +909,7 @@ package body Prj.Env is
end if;
end if;
if Language = No_Name then
if In_Tree.Private_Part.Fill_Mapping_File then
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= null loop
-- Case of unit has a valid name
if Unit.Name /= No_Name then
Data := Unit.File_Names (Spec);
-- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project.
if Data /= No_Source
and then Project_Boolean_Htable.Get (Present, Data.Project)
then
Put_Data (Spec => True);
end if;
Data := Unit.File_Names (Impl);
-- 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 /= No_Source
and then Project_Boolean_Htable.Get (Present, Data.Project)
then
Put_Data (Spec => False);
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end if;
-- If language is defined
else
-- For all source of the Language of all projects in the closure
declare
P : Project_List;
begin
P := In_Tree.Projects;
while P /= null loop
if Project_Boolean_Htable.Get (Present, P.Project) then
Iter := For_Each_Source (In_Tree, P.Project);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
if Source.Language.Name = Language
and then Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path
then
if Source.Unit /= No_Unit_Index then
Get_Name_String (Source.Unit.Name);
if Source.Kind = Spec then
Suffix :=
Source.Language.Config.Mapping_Spec_Suffix;
else
Suffix :=
Source.Language.Config.Mapping_Body_Suffix;
end if;
if Suffix /= No_File then
Add_Str_To_Name_Buffer
(Get_Name_String (Suffix));
end if;
Put_Name_Buffer;
end if;
Get_Name_String (Source.File);
Put_Name_Buffer;
if Source.Locally_Removed then
Name_Len := 1;
Name_Buffer (1 .. Name_Len) := "/";
else
Get_Name_String (Source.Path.Name);
end if;
Put_Name_Buffer;
end if;
Next (Iter);
end loop;
end if;
P := P.Next;
end loop;
end;
end if;
For_Every_Imported_Project (Project, Dummy);
GNAT.OS_Lib.Close (File, Status);
if not Status then
@ -1019,8 +920,6 @@ package body Prj.Env is
Prj.Com.Fail ("disk full, could not write mapping file");
end if;
Project_Boolean_Htable.Reset (Present);
end Create_Mapping_File;
--------------------------

6
gcc/ada/prj-env.ads
View File

@ -41,17 +41,13 @@ package Prj.Env is
procedure Create_Mapping_File
(Project : Project_Id;
Language : Name_Id := No_Name;
Language : Name_Id;
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

74
gcc/ada/prj-nmsc.adb
View File

@ -277,9 +277,14 @@ package body Prj.Nmsc is
procedure Check_Naming_Schemes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Is_Config_File : Boolean);
Is_Config_File : Boolean;
Bodies : out Array_Element_Id;
Specs : out Array_Element_Id);
-- Check the naming scheme part of Data.
-- Is_Config_File should be True if Project is a config file (.cgpr)
-- This also returns the naming scheme exceptions for unit-based
-- languages (Bodies and Specs are associative arrays mapping individual
-- unit names to source file names).
procedure Check_Configuration
(Project : Project_Id;
@ -831,6 +836,8 @@ package body Prj.Nmsc is
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean)
is
Specs : Array_Element_Id;
Bodies : Array_Element_Id;
Extending : Boolean := False;
begin
@ -908,13 +915,11 @@ package body Prj.Nmsc is
Extending := Project.Extends /= No_Project;
Check_Naming_Schemes (Project, In_Tree, Is_Config_File);
Check_Naming_Schemes (Project, In_Tree, Is_Config_File, Bodies, Specs);
if Get_Mode = Ada_Only then
Prepare_Ada_Naming_Exceptions
(Project.Naming.Bodies, In_Tree, Impl);
Prepare_Ada_Naming_Exceptions
(Project.Naming.Specs, In_Tree, Spec);
Prepare_Ada_Naming_Exceptions (Bodies, In_Tree, Impl);
Prepare_Ada_Naming_Exceptions (Specs, In_Tree, Spec);
end if;
-- Find the sources
@ -929,11 +934,11 @@ package body Prj.Nmsc is
-- of this project file.
Warn_If_Not_Sources
(Project, In_Tree, Project.Naming.Bodies,
(Project, In_Tree, Bodies,
Specs => False,
Extending => Extending);
Warn_If_Not_Sources
(Project, In_Tree, Project.Naming.Specs,
(Project, In_Tree, Specs,
Specs => True,
Extending => Extending);
@ -2700,7 +2705,9 @@ package body Prj.Nmsc is
procedure Check_Naming_Schemes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Is_Config_File : Boolean)
Is_Config_File : Boolean;
Bodies : out Array_Element_Id;
Specs : out Array_Element_Id)
is
Naming_Id : constant Package_Id :=
Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree);
@ -3163,20 +3170,18 @@ package body Prj.Nmsc is
Separate_Suffix => Project.Naming.Separate_Suffix,
Sep_Suffix_Loc => Sep_Suffix_Loc);
Project.Naming.Bodies :=
Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
Bodies := Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
if Project.Naming.Bodies /= No_Array_Element then
if Bodies /= No_Array_Element then
Check_And_Normalize_Unit_Names
(Project, In_Tree, Project.Naming.Bodies, "Naming.Bodies");
(Project, In_Tree, Bodies, "Naming.Bodies");
end if;
Project.Naming.Specs :=
Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
Specs := Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
if Project.Naming.Specs /= No_Array_Element then
if Specs /= No_Array_Element then
Check_And_Normalize_Unit_Names
(Project, In_Tree, Project.Naming.Specs, "Naming.Specs");
(Project, In_Tree, Specs, "Naming.Specs");
end if;
-- Check Spec_Suffix
@ -3374,6 +3379,9 @@ package body Prj.Nmsc is
-- Start of processing for Check_Naming_Schemes
begin
Specs := No_Array_Element;
Bodies := No_Array_Element;
-- No Naming package or parsing a configuration file? nothing to do
if Naming_Id /= No_Package and not Is_Config_File then
@ -4229,20 +4237,6 @@ package body Prj.Nmsc is
Project.Naming.Body_Suffix := Impl_Suffixs;
end if;
end;
-- Get the exceptions, if any
Project.Naming.Specification_Exceptions :=
Util.Value_Of
(Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
Project.Naming.Implementation_Exceptions :=
Util.Value_Of
(Name_Implementation_Exceptions,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
end Check_Package_Naming;
@ -7324,16 +7318,22 @@ package body Prj.Nmsc is
-------------------
procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
Unit : constant Unit_Index := Source.Unit;
begin
-- Remove reference in the unit, if necessary
-- If the file was previously already associated with a unit, change it
if Unit /= null
if Source.Unit /= null
and then Source.Kind in Spec_Or_Body
and then Unit.File_Names (Source.Kind) /= null
and then Source.Unit.File_Names (Source.Kind) /= null
then
Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
Unit.File_Names (Source.Kind) := null;
-- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit
if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
end if;
Source.Unit.File_Names (Source.Kind) := null;
end if;
Source.Kind := Kind;

19
gcc/ada/prj.adb
View File

@ -73,11 +73,7 @@ package body Prj is
Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element,
Body_Suffix => No_Array_Element,
Separate_Suffix => No_File,
Specs => No_Array_Element,
Bodies => No_Array_Element,
Specification_Exceptions => No_Array_Element,
Implementation_Exceptions => No_Array_Element);
Separate_Suffix => No_File);
Project_Empty : constant Project_Data :=
(Qualifier => Unspecified,
@ -1455,6 +1451,19 @@ package body Prj is
and then not Source.Locally_Removed;
end Is_Compilable;
------------------------------
-- Object_To_Global_Archive --
------------------------------
function Object_To_Global_Archive (Source : Source_Id) return Boolean is
begin
return Source.Language.Config.Kind = File_Based
and then Source.Kind = Impl
and then Source.Language.Config.Objects_Linked
and then Is_Compilable (Source)
and then Source.Language.Config.Object_Generated;
end Object_To_Global_Archive;
----------------------------
-- Get_Language_From_Name --
----------------------------

33
gcc/ada/prj.ads
View File

@ -399,6 +399,12 @@ package Prj is
-- Return True if we know how to compile Source (i.e. if a compiler is
-- defined). This doesn't indicate whether the source should be compiled.
function Object_To_Global_Archive (Source : Source_Id) return Boolean;
pragma Inline (Object_To_Global_Archive);
-- Return True if the object file should be put in the global archive.
-- This is for Ada, when only the closure of a main needs to be
-- (re)compiled.
function Other_Part (Source : Source_Id) return Source_Id;
pragma Inline (Other_Part);
-- Source ID for the other part, if any: for a spec, indicates its body;
@ -662,7 +668,10 @@ package Prj is
-- Kind of the source: spec, body or subunit
Unit : Unit_Index := No_Unit_Index;
-- Name of the unit, if language is unit based
-- Name of the unit, if language is unit based. This is only set for
-- those finles that are part of the compilation set (for instance a
-- file in an extended project that is overridden will not have this
-- field set).
Index : Int := 0;
-- Index of the source in a multi unit source file (the same Source_Data
@ -673,11 +682,6 @@ package Prj is
Locally_Removed : Boolean := False;
-- True if the source has been "excluded"
Get_Object : Boolean := False;
-- Indicates that the object of the source should be put in the global
-- archive. This is for Ada, when only the closure of a main needs to
-- be compiled/recompiled.
Replaced_By : Source_Id := No_Source;
File : File_Name_Type := No_File;
@ -747,7 +751,6 @@ package Prj is
Unit => No_Unit_Index,
Index => 0,
Locally_Removed => False,
Get_Object => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
@ -848,22 +851,6 @@ package Prj is
Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit
Specs : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual specs to source file names
-- This is specific to unit-based languages.
Bodies : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual bodies to source file names
-- This is specific to unit-based languages.
Specification_Exceptions : Array_Element_Id := No_Array_Element;
-- An associative array listing spec file names that do not have the
-- spec suffix. Not used by Ada. Indexed by programming language name.
Implementation_Exceptions : Array_Element_Id := No_Array_Element;
-- An associative array listing body file names that do not have the
-- body suffix. Not used by Ada. Indexed by programming language name.
end record;
function Spec_Suffix_Of