+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.
-- 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)
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));
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,
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 --
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 --
- --------------
-
- 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;
+ -------------
+ -- Process --
+ -------------
- -- Line with the file name
+ procedure Process (Project : Project_Id; State : in out Integer) is
+ pragma Unreferenced (State);
+ Source : Source_Id;
+ Suffix : File_Name_Type;
+ Iter : Source_Iterator;
- Get_Name_String (Data.File);
- Put_Name_Buffer;
+ begin
+ Iter := For_Each_Source (In_Tree, Project, Language => Language);
- -- Line with the path name
+ loop
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
- if Data.Locally_Removed then
- Name_Len := 1;
- Name_Buffer (1 .. Name_Len) := "/";
- else
- Get_Name_String (Data.Path.Name);
- end if;
+ 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);
+
+ 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 Put_Data;
+ Put_Name_Buffer;
+ end if;
- --------------------
- -- Recursive_Flag --
- --------------------
+ Get_Name_String (Source.File);
+ Put_Name_Buffer;
- procedure Recursive_Flag (Prj : Project_Id) is
- Imported : Project_List;
+ if Source.Locally_Removed then
+ Name_Len := 1;
+ Name_Buffer (1) := '/';
+ else
+ Get_Name_String (Source.Path.Name);
+ end if;
- begin
- -- Nothing to do for non existent project or project that has already
- -- been flagged.
+ Put_Name_Buffer;
+ end if;
- if Prj /= No_Project
- and then not Project_Boolean_Htable.Get (Present, Prj)
- then
- Project_Boolean_Htable.Set (Present, Prj, True);
+ Next (Iter);
+ end loop;
+ end Process;
- Imported := Prj.Imported_Projects;
- while Imported /= null loop
- Recursive_Flag (Imported.Project);
- Imported := Imported.Next;
- end loop;
+ procedure For_Every_Imported_Project is new
+ For_Every_Project_Imported (State => Integer, Action => Process);
- Recursive_Flag (Prj.Extends);
- end if;
- end Recursive_Flag;
+ Dummy : Integer := 0;
-- Start of processing for Create_Mapping_File
begin
- -- Flag the necessary projects
-
- Recursive_Flag (Project);
-- Create the temporary file
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
Prj.Com.Fail ("disk full, could not write mapping file");
end if;
-
- Project_Boolean_Htable.Reset (Present);
end Create_Mapping_File;
--------------------------
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
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;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean)
is
+ Specs : Array_Element_Id;
+ Bodies : Array_Element_Id;
Extending : Boolean := False;
begin
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
-- 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);
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);
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
-- 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
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;
-------------------
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;
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,
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 --
----------------------------
-- 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;
-- 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
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;
Unit => No_Unit_Index,
Index => 0,
Locally_Removed => False,
- Get_Object => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
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
projects / platform / upstream / gcc.git / commitdiff