Skip to content

R
riscv-gcc-1
Commit aa903780 by Emmanuel Briot Committed by Arnaud Charlet
Options

prj-proc.adb, [...] (Load_Naming_Exceptions): New subprogram. 

2009-04-22  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram.
	Minor refactoring to reduce the size of
	Process_Sources_In_Multi_Language_Mode.
	Avoid extra copied of Source_Data, which we found in the past could be
	quite slow.
	(Mark_Excluded_Sources): new subprogram.
	(Remove_Locally_Removed_Files_From_Units): merged into the above
 	Refactors Process_Sources_In_Multi_Language_Mode to reduce its size,
 	and allow better sharing of code between multi_lang and ada_only modes
	(Project_Extends): removed, since exact duplicate of Prj.Is_Extending

From-SVN: r146565
parent 95c05c62
Showing with 185 additions and 188 deletions
gcc/ada/ChangeLog
2009-04-22 Emmanuel Briot <briot@adacore.com> 2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram.
Minor refactoring to reduce the size of
Process_Sources_In_Multi_Language_Mode.
Avoid extra copied of Source_Data, which we found in the past could be
quite slow.
(Mark_Excluded_Sources): new subprogram.
(Remove_Locally_Removed_Files_From_Units): merged into the above
Refactors Process_Sources_In_Multi_Language_Mode to reduce its size,
and allow better sharing of code between multi_lang and ada_only modes
(Project_Extends): removed, since exact duplicate of Prj.Is_Extending
2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.adb, prj.ads (Project_Data.First_Referred_By): * prj-proc.adb, prj.adb, prj.ads (Project_Data.First_Referred_By):
Removed, since unused. Removed, since unused.
......
gcc/ada/prj-nmsc.adb
...@@ -101,6 +101,8 @@ package body Prj.Nmsc is ...@@ -101,6 +101,8 @@ package body Prj.Nmsc is
Spec : File_Name_Type; Spec : File_Name_Type;
Impl : File_Name_Type; Impl : File_Name_Type;
end record; end record;
-- Record special naming schemes for Ada units (name of spec file and name
-- of implementation file).
No_Unit_Exception : constant Unit_Exception := No_Unit_Exception : constant Unit_Exception :=
(Name => No_Name, (Name => No_Name,
...@@ -213,6 +215,14 @@ package body Prj.Nmsc is ...@@ -213,6 +215,14 @@ package body Prj.Nmsc is
-- A table to check if a unit with an exceptional name will hide a source -- A table to check if a unit with an exceptional name will hide a source
-- with a file name following the naming convention. -- with a file name following the naming convention.
procedure Load_Naming_Exceptions
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
-- All source files in Data.First_Source are considered as naming
-- exceptions, and copied into the Source_Names and Unit_Exceptions tables
-- as appropriate.
procedure Add_Source procedure Add_Source
(Id : out Source_Id; (Id : out Source_Id;
Data : in out Project_Data; Data : in out Project_Data;
...@@ -499,7 +509,8 @@ package body Prj.Nmsc is ...@@ -499,7 +509,8 @@ package body Prj.Nmsc is
Data : in out Project_Data; Data : in out Project_Data;
Current_Dir : String); Current_Dir : String);
-- Find all the sources of project Project in project tree In_Tree and -- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. -- update its Data accordingly. This assumes that Data.First_Source has
-- been initialized with the list of excluded sources.
-- --
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
...@@ -517,13 +528,6 @@ package body Prj.Nmsc is ...@@ -517,13 +528,6 @@ package body Prj.Nmsc is
-- Prepare the internal hash tables used for checking naming exceptions -- Prepare the internal hash tables used for checking naming exceptions
-- for Ada. Insert all elements of List in the tables. -- for Ada. Insert all elements of List in the tables.
function Project_Extends
(Extending : Project_Id;
Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean;
-- Returns True if Extending is extending Extended either directly or
-- indirectly.
procedure Record_Ada_Source procedure Record_Ada_Source
(File_Name : File_Name_Type; (File_Name : File_Name_Type;
Path_Name : Path_Name_Type; Path_Name : Path_Name_Type;
...@@ -8602,198 +8606,198 @@ package body Prj.Nmsc is ...@@ -8602,198 +8606,198 @@ package body Prj.Nmsc is
end if; end if;
end Search_Directories; end Search_Directories;
---------------------- ----------------------------
-- Look_For_Sources -- -- Load_Naming_Exceptions --
---------------------- ----------------------------
procedure Look_For_Sources procedure Load_Naming_Exceptions
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data)
Current_Dir : String)
is is
procedure Remove_Locally_Removed_Files_From_Units; Source : Source_Id := Data.First_Source;
-- Mark all locally removed sources as such in the Units table File : File_Name_Type;
Unit : Name_Id;
begin
Unit_Exceptions.Reset;
procedure Process_Sources_In_Multi_Language_Mode; while Source /= No_Source loop
-- Find all source files when in multi language mode File := In_Tree.Sources.Table (Source).File;
Unit := In_Tree.Sources.Table (Source).Unit;
--------------------------------------------- -- An excluded file cannot also be an exception file name
-- Remove_Locally_Removed_Files_From_Units --
---------------------------------------------
procedure Remove_Locally_Removed_Files_From_Units is if Excluded_Sources_Htable.Get (File) /= No_File_Found then
Excluded : File_Found; Error_Msg_File_1 := File;
OK : Boolean; Error_Msg
Unit : Unit_Data; (Project, In_Tree,
Extended : Project_Id; "{ cannot be both excluded and an exception file name",
No_Location);
begin end if;
Excluded := Excluded_Sources_Htable.Get_First;
while Excluded /= No_File_Found loop
OK := False;
For_Each_Unit : if Current_Verbosity = High then
for Index in Unit_Table.First .. Write_Str ("Naming exception: Putting source #");
Unit_Table.Last (In_Tree.Units) Write_Str (Source'Img);
loop Write_Str (", file ");
Unit := In_Tree.Units.Table (Index); Write_Str (Get_Name_String (File));
Write_Line (" in Source_Names");
end if;
for Kind in Spec_Or_Body'Range loop Source_Names.Set
if Unit.File_Names (Kind).Name = Excluded.File then (K => File,
OK := True; E => Name_Location'
(Name => File,
Location => No_Location,
Source => Source,
Except => Unit /= No_Name,
Found => False));
-- Check that this is from the current project or -- If this is an Ada exception, record in table Unit_Exceptions
-- that the current project extends.
Extended := Unit.File_Names (Kind).Project; if Unit /= No_Name then
declare
Unit_Except : Unit_Exception := Unit_Exceptions.Get (Unit);
if Extended = Project begin
or else Project_Extends (Project, Extended, In_Tree) Unit_Except.Name := Unit;
then
Unit.File_Names (Kind).Path.Name := Slash;
Unit.File_Names (Kind).Needs_Pragma := False;
In_Tree.Units.Table (Index) := Unit;
Add_Forbidden_File_Name
(Unit.File_Names (Kind).Name);
else
Error_Msg
(Project, In_Tree,
"cannot remove a source from " &
"another project",
Excluded.Location);
end if;
exit For_Each_Unit;
end if;
end loop;
end loop For_Each_Unit;
if not OK then if In_Tree.Sources.Table (Source).Kind = Spec then
Err_Vars.Error_Msg_File_1 := Excluded.File; Unit_Except.Spec := File;
Error_Msg else
(Project, In_Tree, "unknown file {", Excluded.Location); Unit_Except.Impl := File;
end if; end if;
Excluded := Excluded_Sources_Htable.Get_Next; Unit_Exceptions.Set (Unit, Unit_Except);
end loop; end;
end Remove_Locally_Removed_Files_From_Units; end if;
-------------------------------------------- Source := In_Tree.Sources.Table (Source).Next_In_Project;
-- Process_Sources_In_Multi_Language_Mode -- end loop;
-------------------------------------------- end Load_Naming_Exceptions;
procedure Process_Sources_In_Multi_Language_Mode is ----------------------
Source : Source_Id; -- Look_For_Sources --
Name_Loc : Name_Location; ----------------------
OK : Boolean;
FF : File_Found;
begin procedure Look_For_Sources
-- First, put all naming exceptions if any, in the Source_Names table (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
Current_Dir : String)
is
procedure Process_Sources_In_Multi_Language_Mode;
-- Find all source files when in multi language mode
Unit_Exceptions.Reset; procedure Mark_Excluded_Sources;
-- Mark as such the sources that are declared as excluded
Source := Data.First_Source; ---------------------------
while Source /= No_Source loop -- Mark_Excluded_Sources --
declare ---------------------------
Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
begin procedure Mark_Excluded_Sources is
-- An excluded file cannot also be an exception file name Source : Source_Id := No_Source;
OK : Boolean;
Unit : Unit_Data;
Excluded : File_Found := Excluded_Sources_Htable.Get_First;
if Excluded_Sources_Htable.Get (Src_Data.File) /= procedure Exclude
No_File_Found (Extended : Project_Id; Index : Unit_Index; Kind : Spec_Or_Body);
then -- If the current file (Excluded) belongs to the current project or
Error_Msg_File_1 := Src_Data.File; -- one that the current project extends, then mark this file/unit as
Error_Msg -- excluded. It is an error to locally remove a file from another
(Project, In_Tree, -- project.
"{ cannot be both excluded and an exception file name",
No_Location);
end if;
Name_Loc := (Name => Src_Data.File, procedure Exclude
Location => No_Location, (Extended : Project_Id; Index : Unit_Index; Kind : Spec_Or_Body) is
Source => Source, begin
Except => Src_Data.Unit /= No_Name, if Extended = Project
Found => False); or else Is_Extending (Project, Extended, In_Tree)
then
OK := True;
if Current_Verbosity = High then if Index /= No_Unit_Index then
Write_Str ("Putting source #"); Unit.File_Names (Kind).Path.Name := Slash;
Write_Str (Source'Img); Unit.File_Names (Kind).Needs_Pragma := False;
Write_Str (", file "); In_Tree.Units.Table (Index) := Unit;
Write_Str (Get_Name_String (Src_Data.File));
Write_Line (" in Source_Names");
end if; end if;
Source_Names.Set (K => Src_Data.File, E => Name_Loc); if Source /= No_Source then
In_Tree.Sources.Table (Source).Locally_Removed := True;
-- If this is an Ada exception, record in table Unit_Exceptions In_Tree.Sources.Table (Source).In_Interfaces := False;
if Src_Data.Unit /= No_Name then
declare
Unit_Except : Unit_Exception :=
Unit_Exceptions.Get (Src_Data.Unit);
begin
Unit_Except.Name := Src_Data.Unit;
if Src_Data.Kind = Spec then
Unit_Except.Spec := Src_Data.File;
else
Unit_Except.Impl := Src_Data.File;
end if;
Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
end;
end if; end if;
Source := Src_Data.Next_In_Project; if Current_Verbosity = High then
end; Write_Str ("Removing file ");
end loop; Write_Line (Get_Name_String (Excluded.File));
end if;
Find_Explicit_Sources Add_Forbidden_File_Name (Excluded.File);
(Current_Dir, Project, In_Tree, Data);
-- Mark as such the sources that are declared as excluded else
Error_Msg
(Project, In_Tree,
"cannot remove a source from another project",
Excluded.Location);
end if;
end Exclude;
FF := Excluded_Sources_Htable.Get_First; begin
while FF /= No_File_Found loop while Excluded /= No_File_Found loop
OK := False; OK := False;
Source := In_Tree.First_Source;
while Source /= No_Source loop
declare
Src_Data : Source_Data renames
In_Tree.Sources.Table (Source);
begin case Get_Mode is
if Src_Data.File = FF.File then when Ada_Only =>
-- ??? This loop could be the same as for Multi_Language if
-- Check that this is from this project or a project that -- we were setting In_Tree.First_Source when we search for
-- the current project extends. -- Ada sources (basically once we have removed the use of
-- Data.Ada_Sources).
For_Each_Unit :
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Index);
if Src_Data.Project = Project or else for Kind in Spec_Or_Body'Range loop
Is_Extending (Project, Src_Data.Project, In_Tree) if Unit.File_Names (Kind).Name = Excluded.File then
then Exclude (Unit.File_Names (Kind).Project, Index, Kind);
Src_Data.Locally_Removed := True; exit For_Each_Unit;
Src_Data.In_Interfaces := False;
Add_Forbidden_File_Name (FF.File);
OK := True;
exit;
end if; end if;
end loop;
end loop For_Each_Unit;
when Multi_Language =>
Source := In_Tree.First_Source;
while Source /= No_Source loop
if In_Tree.Sources.Table (Source).File = Excluded.File then
Exclude
(In_Tree.Sources.Table (Source).Project,
No_Unit_Index, Specification);
exit;
end if; end if;
Source := Src_Data.Next_In_Sources; Source := In_Tree.Sources.Table (Source).Next_In_Sources;
end; end loop;
end loop;
OK := OK or Excluded.Found;
end case;
if not FF.Found and not OK then if not OK then
Err_Vars.Error_Msg_File_1 := FF.File; Err_Vars.Error_Msg_File_1 := Excluded.File;
Error_Msg (Project, In_Tree, "unknown file {", FF.Location); Error_Msg
(Project, In_Tree, "unknown file {", Excluded.Location);
end if; end if;
FF := Excluded_Sources_Htable.Get_Next; Excluded := Excluded_Sources_Htable.Get_Next;
end loop; end loop;
end Mark_Excluded_Sources;
--------------------------------------------
-- Process_Sources_In_Multi_Language_Mode --
--------------------------------------------
procedure Process_Sources_In_Multi_Language_Mode is
begin
-- Check that two sources of this project do not have the same object -- Check that two sources of this project do not have the same object
-- file name. -- file name.
...@@ -8840,8 +8844,7 @@ package body Prj.Nmsc is ...@@ -8840,8 +8844,7 @@ package body Prj.Nmsc is
begin begin
if Src_Data.Compiled and then Src_Data.Object_Exists if Src_Data.Compiled and then Src_Data.Object_Exists
and then Project_Extends and then Is_Extending (Project, Src_Data.Project, In_Tree)
(Project, Src_Data.Project, In_Tree)
then then
if Src_Data.Unit = No_Name then if Src_Data.Unit = No_Name then
if Src_Data.Kind = Impl then if Src_Data.Kind = Impl then
...@@ -8901,11 +8904,14 @@ package body Prj.Nmsc is ...@@ -8901,11 +8904,14 @@ package body Prj.Nmsc is
when Ada_Only => when Ada_Only =>
if Is_A_Language (In_Tree, Data, Name_Ada) then if Is_A_Language (In_Tree, Data, Name_Ada) then
Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data); Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
Remove_Locally_Removed_Files_From_Units; Mark_Excluded_Sources;
end if; end if;
when Multi_Language => when Multi_Language =>
if Data.First_Language_Processing /= No_Language_Index then if Data.First_Language_Processing /= No_Language_Index then
Load_Naming_Exceptions (Project, In_Tree, Data);
Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
Mark_Excluded_Sources;
Process_Sources_In_Multi_Language_Mode; Process_Sources_In_Multi_Language_Mode;
end if; end if;
end case; end case;
...@@ -8983,30 +8989,6 @@ package body Prj.Nmsc is ...@@ -8983,30 +8989,6 @@ package body Prj.Nmsc is
end loop; end loop;
end Prepare_Ada_Naming_Exceptions; end Prepare_Ada_Naming_Exceptions;
---------------------
-- Project_Extends --
---------------------
function Project_Extends
(Extending : Project_Id;
Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean
is
Current : Project_Id := Extending;
begin
loop
if Current = No_Project then
return False;
elsif Current = Extended then
return True;
end if;
Current := In_Tree.Projects.Table (Current).Extends;
end loop;
end Project_Extends;
----------------------- -----------------------
-- Record_Ada_Source -- -- Record_Ada_Source --
----------------------- -----------------------
...@@ -9173,7 +9155,7 @@ package body Prj.Nmsc is ...@@ -9173,7 +9155,7 @@ package body Prj.Nmsc is
The_Unit_Data.File_Names The_Unit_Data.File_Names
(Unit_Kind).Path.Name = Slash) (Unit_Kind).Path.Name = Slash)
or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
or else Project_Extends or else Is_Extending
(Data.Extends, (Data.Extends,
The_Unit_Data.File_Names (Unit_Kind).Project, The_Unit_Data.File_Names (Unit_Kind).Project,
In_Tree) In_Tree)
......
gcc/ada/prj-proc.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -2632,6 +2632,7 @@ package body Prj.Proc is ...@@ -2632,6 +2632,7 @@ package body Prj.Proc is
declare declare
New_Project : Project_Id; New_Project : Project_Id;
New_Data : Project_Data; New_Data : Project_Data;
pragma Unreferenced (New_Data);
Proj_Node : Project_Node_Id; Proj_Node : Project_Node_Id;
begin begin
...@@ -2834,6 +2835,7 @@ package body Prj.Proc is ...@@ -2834,6 +2835,7 @@ package body Prj.Proc is
declare declare
New_Project : Project_Id; New_Project : Project_Id;
New_Data : Project_Data; New_Data : Project_Data;
pragma Unreferenced (New_Data);
Proj_Node : Project_Node_Id; Proj_Node : Project_Node_Id;
begin begin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment