Commit b0159fbe by Arnaud Charlet

[multiple changes]

2009-07-11  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_res.adb, sem_warn.adb: Minor comment editing:
	Lvalue -> lvalue

	* exp_ch6.adb: Minor reformatting

2009-07-11  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Expand_Atomic_Aggregate): Clean up code, take into
	account possible type qualification to determine whether aggregate
	needs a target temporary to respect atomic type or object.

	* exp_aggr.adb (Expand_Record_Aggregate): Use new version of
	Expand_Atomic_Aggregate.

2009-07-11  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Speed up
	algorithm.
	(Excluded_Sources_Htable): No longer a global table.
	Change error message to indicate which files are illegal in the list
	of excluded files, as opposed to only the location in the project
	file.
	(Find_Source): New subprogram.

From-SVN: r149515
parent 3e3a9a6a
2009-07-11 Thomas Quinot <quinot@adacore.com>
* sem_util.adb, sem_res.adb, sem_warn.adb: Minor comment editing:
Lvalue -> lvalue
* exp_ch6.adb: Minor reformatting
2009-07-11 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Expand_Atomic_Aggregate): Clean up code, take into
account possible type qualification to determine whether aggregate
needs a target temporary to respect atomic type or object.
* exp_aggr.adb (Expand_Record_Aggregate): Use new version of
Expand_Atomic_Aggregate.
2009-07-11 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Speed up
algorithm.
(Excluded_Sources_Htable): No longer a global table.
Change error message to indicate which files are illegal in the list
of excluded files, as opposed to only the location in the project
file.
(Find_Source): New subprogram.
2009-07-10 Thomas Quinot <quinot@adacore.com> 2009-07-10 Thomas Quinot <quinot@adacore.com>
* exp_ch7.adb: Update comments. * exp_ch7.adb: Update comments.
......
...@@ -5475,11 +5475,9 @@ package body Exp_Aggr is ...@@ -5475,11 +5475,9 @@ package body Exp_Aggr is
-- an atomic move for it. -- an atomic move for it.
if Is_Atomic (Typ) if Is_Atomic (Typ)
and then Nkind_In (Parent (N), N_Object_Declaration,
N_Assignment_Statement)
and then Comes_From_Source (Parent (N)) and then Comes_From_Source (Parent (N))
and then Expand_Atomic_Aggregate (N, Typ)
then then
Expand_Atomic_Aggregate (N, Typ);
return; return;
-- No special management required for aggregates used to initialize -- No special management required for aggregates used to initialize
......
...@@ -1146,7 +1146,7 @@ package body Exp_Ch6 is ...@@ -1146,7 +1146,7 @@ package body Exp_Ch6 is
-- resulting variable is a temporary which does not designate -- resulting variable is a temporary which does not designate
-- the proper out-parameter, which may not be addressable. In -- the proper out-parameter, which may not be addressable. In
-- that case, generate an assignment to the original expression -- that case, generate an assignment to the original expression
-- (before expansion of the packed reference) so that the proper -- (before expansion of the packed reference) so that the proper
-- expansion of assignment to a packed component can take place. -- expansion of assignment to a packed component can take place.
declare declare
...@@ -4661,7 +4661,7 @@ package body Exp_Ch6 is ...@@ -4661,7 +4661,7 @@ package body Exp_Ch6 is
end if; end if;
-- Analyze and resolve the new call. The actuals have already been -- Analyze and resolve the new call. The actuals have already been
-- resolved, but expansion of a function call will add extra actuals -- resolved, but expansion of a function call will add extra actuals
-- if needed. Analysis of a procedure call already includes resolution. -- if needed. Analysis of a procedure call already includes resolution.
Analyze (N); Analyze (N);
......
...@@ -1115,15 +1115,27 @@ package body Freeze is ...@@ -1115,15 +1115,27 @@ package body Freeze is
-- Expand_Atomic_Aggregate -- -- Expand_Atomic_Aggregate --
----------------------------- -----------------------------
procedure Expand_Atomic_Aggregate (E : Entity_Id; Typ : Entity_Id) is function Expand_Atomic_Aggregate
(E : Entity_Id;
Typ : Entity_Id) return Boolean
is
Loc : constant Source_Ptr := Sloc (E); Loc : constant Source_Ptr := Sloc (E);
New_N : Node_Id; New_N : Node_Id;
Par : Node_Id;
Temp : Entity_Id; Temp : Entity_Id;
begin begin
if (Nkind (Parent (E)) = N_Object_Declaration Par := Parent (E);
or else Nkind (Parent (E)) = N_Assignment_Statement)
and then Comes_From_Source (Parent (E)) -- Array may be qualified, so find outer context.
if Nkind (Par) = N_Qualified_Expression then
Par := Parent (Par);
end if;
if (Nkind (Par) = N_Object_Declaration
or else Nkind (Par) = N_Assignment_Statement)
and then Comes_From_Source (Par)
then then
Temp := Temp :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
...@@ -1134,11 +1146,14 @@ package body Freeze is ...@@ -1134,11 +1146,14 @@ package body Freeze is
Defining_Identifier => Temp, Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc), Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E)); Expression => Relocate_Node (E));
Insert_Before (Parent (E), New_N); Insert_Before (Par, New_N);
Analyze (New_N); Analyze (New_N);
Set_Expression (Parent (E), New_Occurrence_Of (Temp, Loc)); Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
return True;
else
return False;
end if; end if;
end Expand_Atomic_Aggregate; end Expand_Atomic_Aggregate;
...@@ -2351,8 +2366,10 @@ package body Freeze is ...@@ -2351,8 +2366,10 @@ package body Freeze is
and then Nkind (Parent (E)) = N_Object_Declaration and then Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E))) and then Present (Expression (Parent (E)))
and then Nkind (Expression (Parent (E))) = N_Aggregate and then Nkind (Expression (Parent (E))) = N_Aggregate
and then
Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E))
then then
Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E)); null;
end if; end if;
-- For a subprogram, freeze all parameter types and also the return -- For a subprogram, freeze all parameter types and also the return
......
...@@ -175,12 +175,17 @@ package Freeze is ...@@ -175,12 +175,17 @@ package Freeze is
-- do not allow a size clause if the size would not otherwise be known at -- do not allow a size clause if the size would not otherwise be known at
-- compile time in any case. -- compile time in any case.
procedure Expand_Atomic_Aggregate (E : Entity_Id; Typ : Entity_Id); function Expand_Atomic_Aggregate
(E : Entity_Id;
Typ : Entity_Id) return Boolean;
-- If an atomic object is initialized with an aggregate or is assigned -- If an atomic object is initialized with an aggregate or is assigned
-- an aggregate, we have to prevent a piecemeal access or assignment -- an aggregate, we have to prevent a piecemeal access or assignment
-- to the object, even if the aggregate is to be expanded. We create -- to the object, even if the aggregate is to be expanded. We create
-- a temporary for the aggregate, and assign the temporary instead, -- a temporary for the aggregate, and assign the temporary instead,
-- so that the back end can generate an atomic move for it. -- so that the back end can generate an atomic move for it. This is
-- only done in the context of an object declaration or an assignment.
-- Function is a noop and returns false in other contexts.
function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id; function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id;
-- Freeze an entity, and return Freeze nodes, to be inserted at the -- Freeze an entity, and return Freeze nodes, to be inserted at the
......
...@@ -181,7 +181,7 @@ package body Prj.Nmsc is ...@@ -181,7 +181,7 @@ package body Prj.Nmsc is
No_File_Found : constant File_Found := (No_File, False, No_Location); No_File_Found : constant File_Found := (No_File, False, No_Location);
-- Comments needed ??? -- Comments needed ???
package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => File_Found, Element => File_Found,
No_Element => No_File_Found, No_Element => No_File_Found,
...@@ -192,8 +192,9 @@ package body Prj.Nmsc is ...@@ -192,8 +192,9 @@ package body Prj.Nmsc is
-- Find_Excluded_Sources below. -- Find_Excluded_Sources below.
procedure Find_Excluded_Sources procedure Find_Excluded_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref;
Excluded : in out Excluded_Sources_Htable.Instance);
-- Find the list of files that should not be considered as source files -- Find the list of files that should not be considered as source files
-- for this project. Sets the list in the Excluded_Sources_Htable. -- for this project. Sets the list in the Excluded_Sources_Htable.
...@@ -224,8 +225,9 @@ package body Prj.Nmsc is ...@@ -224,8 +225,9 @@ package body Prj.Nmsc is
-- with a file name following the naming convention. -- with a file name following the naming convention.
procedure Load_Naming_Exceptions procedure Load_Naming_Exceptions
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref;
Excluded : in out Excluded_Sources_Htable.Instance);
-- All source files in Data.First_Source are considered as naming -- All source files in Data.First_Source are considered as naming
-- exceptions, and copied into the Source_Names and Unit_Exceptions tables -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
-- as appropriate. -- as appropriate.
...@@ -378,7 +380,8 @@ package body Prj.Nmsc is ...@@ -378,7 +380,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
For_All_Sources : Boolean; For_All_Sources : Boolean;
Allow_Duplicate_Basenames : Boolean); Allow_Duplicate_Basenames : Boolean;
Excluded : in out Excluded_Sources_Htable.Instance);
-- Search the source directories to find the sources. If For_All_Sources is -- Search the source directories to find the sources. If For_All_Sources is
-- True, check each regular file name against the naming schemes of the -- True, check each regular file name against the naming schemes of the
-- different languages. Otherwise consider only the file names in the hash -- different languages. Otherwise consider only the file names in the hash
...@@ -462,7 +465,8 @@ package body Prj.Nmsc is ...@@ -462,7 +465,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Proc_Data : in out Processing_Data; Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean); Allow_Duplicate_Basenames : Boolean;
Excluded : in out Excluded_Sources_Htable.Instance);
-- Process the Source_Files and Source_List_File attributes, and store the -- Process the Source_Files and Source_List_File attributes, and store the
-- list of source files into the Source_Names htable. When these attributes -- list of source files into the Source_Names htable. When these attributes
-- are not defined, find all files matching the naming schemes in the -- are not defined, find all files matching the naming schemes in the
...@@ -6573,8 +6577,9 @@ package body Prj.Nmsc is ...@@ -6573,8 +6577,9 @@ package body Prj.Nmsc is
--------------------------- ---------------------------
procedure Find_Excluded_Sources procedure Find_Excluded_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref;
Excluded : in out Excluded_Sources_Htable.Instance)
is is
Excluded_Source_List_File : constant Variable_Value := Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
...@@ -6606,7 +6611,7 @@ package body Prj.Nmsc is ...@@ -6606,7 +6611,7 @@ package body Prj.Nmsc is
(Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree); (Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree);
end if; end if;
Excluded_Sources_Htable.Reset; Excluded_Sources_Htable.Reset (Excluded);
-- If there are excluded sources, put them in the table -- If there are excluded sources, put them in the table
...@@ -6641,7 +6646,8 @@ package body Prj.Nmsc is ...@@ -6641,7 +6646,8 @@ package body Prj.Nmsc is
Location := Element.Location; Location := Element.Location;
end if; end if;
Excluded_Sources_Htable.Set (Name, (Name, False, Location)); Excluded_Sources_Htable.Set
(Excluded, Name, (Name, False, Location));
Current := Element.Next; Current := Element.Next;
end loop; end loop;
...@@ -6706,7 +6712,7 @@ package body Prj.Nmsc is ...@@ -6706,7 +6712,7 @@ package body Prj.Nmsc is
end loop; end loop;
Excluded_Sources_Htable.Set Excluded_Sources_Htable.Set
(Name, (Name, False, Location)); (Excluded, Name, (Name, False, Location));
end if; end if;
end loop; end loop;
...@@ -6725,7 +6731,8 @@ package body Prj.Nmsc is ...@@ -6725,7 +6731,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Proc_Data : in out Processing_Data; Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean) Allow_Duplicate_Basenames : Boolean;
Excluded : in out Excluded_Sources_Htable.Instance)
is is
Sources : constant Variable_Value := Sources : constant Variable_Value :=
Util.Value_Of Util.Value_Of
...@@ -6894,7 +6901,8 @@ package body Prj.Nmsc is ...@@ -6894,7 +6901,8 @@ package body Prj.Nmsc is
(Project, In_Tree, (Project, In_Tree,
For_All_Sources => For_All_Sources =>
Sources.Default and then Source_List_File.Default, Sources.Default and then Source_List_File.Default,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames); Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
Excluded => Excluded);
end if; end if;
-- Check if all exceptions have been found. For Ada, it is an error if -- Check if all exceptions have been found. For Ada, it is an error if
...@@ -7548,7 +7556,8 @@ package body Prj.Nmsc is ...@@ -7548,7 +7556,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
For_All_Sources : Boolean; For_All_Sources : Boolean;
Allow_Duplicate_Basenames : Boolean) Allow_Duplicate_Basenames : Boolean;
Excluded : in out Excluded_Sources_Htable.Instance)
is is
Source_Dir : String_List_Id; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
...@@ -7633,8 +7642,8 @@ package body Prj.Nmsc is ...@@ -7633,8 +7642,8 @@ package body Prj.Nmsc is
-- Case_Sensitive set True (no folding) -- Case_Sensitive set True (no folding)
Path : Path_Name_Type; Path : Path_Name_Type;
FF : File_Found := FF : File_Found := Excluded_Sources_Htable.Get
Excluded_Sources_Htable.Get (File_Name); (Excluded, File_Name);
begin begin
Name_Len := Path_Name'Length; Name_Len := Path_Name'Length;
...@@ -7644,7 +7653,8 @@ package body Prj.Nmsc is ...@@ -7644,7 +7653,8 @@ package body Prj.Nmsc is
if FF /= No_File_Found then if FF /= No_File_Found then
if not FF.Found then if not FF.Found then
FF.Found := True; FF.Found := True;
Excluded_Sources_Htable.Set (File_Name, FF); Excluded_Sources_Htable.Set
(Excluded, File_Name, FF);
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" excluded source """); Write_Str (" excluded source """);
...@@ -7691,8 +7701,9 @@ package body Prj.Nmsc is ...@@ -7691,8 +7701,9 @@ package body Prj.Nmsc is
---------------------------- ----------------------------
procedure Load_Naming_Exceptions procedure Load_Naming_Exceptions
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref;
Excluded : in out Excluded_Sources_Htable.Instance)
is is
Source : Source_Id; Source : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
...@@ -7707,7 +7718,9 @@ package body Prj.Nmsc is ...@@ -7707,7 +7718,9 @@ package body Prj.Nmsc is
-- An excluded file cannot also be an exception file name -- An excluded file cannot also be an exception file name
if Excluded_Sources_Htable.Get (Source.File) /= No_File_Found then if Excluded_Sources_Htable.Get (Excluded, Source.File) /=
No_File_Found
then
Error_Msg_File_1 := Source.File; Error_Msg_File_1 := Source.File;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -7764,7 +7777,9 @@ package body Prj.Nmsc is ...@@ -7764,7 +7777,9 @@ package body Prj.Nmsc is
Proc_Data : in out Processing_Data; Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean) Allow_Duplicate_Basenames : Boolean)
is is
Iter : Source_Iterator; Iter : Source_Iterator;
Src : Source_Id;
Excluded_Sources : Excluded_Sources_Htable.Instance;
procedure Process_Sources_In_Multi_Language_Mode; procedure Process_Sources_In_Multi_Language_Mode;
-- Find all source files when in multi language mode -- Find all source files when in multi language mode
...@@ -7778,69 +7793,66 @@ package body Prj.Nmsc is ...@@ -7778,69 +7793,66 @@ package body Prj.Nmsc is
procedure Mark_Excluded_Sources is procedure Mark_Excluded_Sources is
Source : Source_Id := No_Source; Source : Source_Id := No_Source;
OK : Boolean;
Excluded : File_Found; Excluded : File_Found;
Proj : Project_Id;
begin begin
Excluded := Excluded_Sources_Htable.Get_First; Proj := Project;
while Excluded /= No_File_Found loop while Proj /= No_Project loop
OK := False; Iter := For_Each_Source (In_Tree, Proj);
while Prj.Element (Iter) /= No_Source loop
Source := Prj.Element (Iter);
Excluded := Excluded_Sources_Htable.Get
(Excluded_Sources, Source.File);
if Excluded /= No_File_Found then
Source.Locally_Removed := True;
Source.In_Interfaces := False;
-- ??? Don't we have a hash table to map files to Source_Id? if Current_Verbosity = High then
-- ??? Why can't simply iterate over the sources of the current Write_Str ("Removing file ");
-- project, as opposed to the whole tree ? Write_Line
(Get_Name_String (Excluded.File)
& " " & Get_Name_String (Source.Project.Name));
end if;
Iter := For_Each_Source (In_Tree); Excluded_Sources_Htable.Remove
loop (Excluded_Sources, Source.File);
Source := Prj.Element (Iter); end if;
exit when Source = No_Source;
if Source.File = Excluded.File then Next (Iter);
if Source.Project = Project end loop;
or else Is_Extending (Project, Source.Project)
then
OK := True;
Source.Locally_Removed := True;
Source.In_Interfaces := False;
if Current_Verbosity = High then Proj := Proj.Extends;
Write_Str ("Removing file "); end loop;
Write_Line
(Get_Name_String (Excluded.File)
& " " & Get_Name_String (Source.Project.Name));
end if;
else -- If we have any excluded element left, that means we did not find
Error_Msg -- the source file
(Project, In_Tree,
"cannot remove a source from another project",
Excluded.Location);
end if;
-- We used to exit here, but in fact when a source is Excluded := Excluded_Sources_Htable.Get_First (Excluded_Sources);
-- overridden in an extended project we have only marked the while Excluded /= No_File_Found loop
-- original source file if we stop here, not the one from
-- the extended project.
-- ??? We could exit (and thus be faster) if the loop could
-- be done only on the current project, but this isn't
-- compatible with the way gprbuild works with excluded
-- sources apparently
-- exit; -- Check if the file belongs to another imported project to
end if; -- provide a better error message.
Next (Iter); Src := Find_Source
end loop; (In_Tree => In_Tree,
Project => Project,
In_Imported_Only => True,
Base_Name => Excluded.File);
OK := OK or Excluded.Found; Err_Vars.Error_Msg_File_1 := Excluded.File;
if not OK then if Src = No_Source then
Err_Vars.Error_Msg_File_1 := Excluded.File;
Error_Msg Error_Msg
(Project, In_Tree, "unknown file {", Excluded.Location); (Project, In_Tree, "unknown file {", Excluded.Location);
else
Error_Msg
(Project, In_Tree,
"cannot remove a source from an imported project: {",
Excluded.Location);
end if; end if;
Excluded := Excluded_Sources_Htable.Get_Next; Excluded := Excluded_Sources_Htable.Get_Next (Excluded_Sources);
end loop; end loop;
end Mark_Excluded_Sources; end Mark_Excluded_Sources;
...@@ -7949,17 +7961,19 @@ package body Prj.Nmsc is ...@@ -7949,17 +7961,19 @@ package body Prj.Nmsc is
begin begin
Source_Names.Reset; Source_Names.Reset;
Find_Excluded_Sources (Project, In_Tree); Find_Excluded_Sources (Project, In_Tree, Excluded_Sources);
if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada)) if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada))
or else (Get_Mode = Multi_Language or else (Get_Mode = Multi_Language
and then Project.Languages /= No_Language_Index) and then Project.Languages /= No_Language_Index)
then then
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Load_Naming_Exceptions (Project, In_Tree); Load_Naming_Exceptions (Project, In_Tree, Excluded_Sources);
end if; end if;
Find_Sources (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames); Find_Sources
(Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames,
Excluded => Excluded_Sources);
Mark_Excluded_Sources; Mark_Excluded_Sources;
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
......
...@@ -469,6 +469,52 @@ package body Prj is ...@@ -469,6 +469,52 @@ package body Prj is
Reset (Seen); Reset (Seen);
end For_Every_Project_Imported; end For_Every_Project_Imported;
-----------------
-- Find_Source --
-----------------
function Find_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean;
Base_Name : File_Name_Type) return Source_Id
is
Result : Source_Id := No_Source;
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id);
-- Look for Base_Name in the sources of Proj
procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id) is
Iterator : Source_Iterator;
begin
Iterator := For_Each_Source (In_Tree => In_Tree, Project => Proj);
while Element (Iterator) /= No_Source loop
if Element (Iterator).File = Base_Name then
Src := Element (Iterator);
return;
end if;
Next (Iterator);
end loop;
end Look_For_Sources;
procedure For_Imported_Projects is new For_Every_Project_Imported
(State => Source_Id, Action => Look_For_Sources);
begin
if In_Imported_Only then
Look_For_Sources (Project, Result);
if Result = No_Source then
For_Imported_Projects
(By => Project,
With_State => Result);
end if;
else
Look_For_Sources (No_Project, Result);
end if;
return Result;
end Find_Source;
-------------- --------------
-- Get_Mode -- -- Get_Mode --
-------------- --------------
......
...@@ -1295,6 +1295,15 @@ package Prj is ...@@ -1295,6 +1295,15 @@ package Prj is
procedure Next (Iter : in out Source_Iterator); procedure Next (Iter : in out Source_Iterator);
-- Move on to the next source -- Move on to the next source
function Find_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean;
Base_Name : File_Name_Type) return Source_Id;
-- Find the first source file with the given name either in the whole tree
-- (if In_Imported_Only is False) or in the projects imported or extended
-- by Project otherwise.
----------------------- -----------------------
-- Project_Tree_Data -- -- Project_Tree_Data --
----------------------- -----------------------
......
...@@ -7600,7 +7600,7 @@ package body Sem_Res is ...@@ -7600,7 +7600,7 @@ package body Sem_Res is
-- Generate cross-reference. We needed to wait until full overloading -- Generate cross-reference. We needed to wait until full overloading
-- resolution was complete to do this, since otherwise we can't tell if -- resolution was complete to do this, since otherwise we can't tell if
-- we are an Lvalue of not. -- we are an lvalue of not.
if May_Be_Lvalue (N) then if May_Be_Lvalue (N) then
Generate_Reference (Entity (S), S, 'm'); Generate_Reference (Entity (S), S, 'm');
......
...@@ -7155,7 +7155,7 @@ package body Sem_Util is ...@@ -7155,7 +7155,7 @@ package body Sem_Util is
when N_Assignment_Statement => when N_Assignment_Statement =>
return N = Name (P); return N = Name (P);
-- Function call arguments are never Lvalues -- Function call arguments are never lvalues
when N_Function_Call => when N_Function_Call =>
return False; return False;
...@@ -7241,7 +7241,7 @@ package body Sem_Util is ...@@ -7241,7 +7241,7 @@ package body Sem_Util is
end; end;
-- Test for appearing in a conversion that itself appears -- Test for appearing in a conversion that itself appears
-- in an Lvalue context, since this should be an Lvalue. -- in an lvalue context, since this should be an lvalue.
when N_Type_Conversion => when N_Type_Conversion =>
return Known_To_Be_Assigned (P); return Known_To_Be_Assigned (P);
...@@ -7276,8 +7276,8 @@ package body Sem_Util is ...@@ -7276,8 +7276,8 @@ package body Sem_Util is
return N = Prefix (P) return N = Prefix (P)
and then Name_Implies_Lvalue_Prefix (Attribute_Name (P)); and then Name_Implies_Lvalue_Prefix (Attribute_Name (P));
-- For an expanded name, the name is an Lvalue if the expanded name -- For an expanded name, the name is an lvalue if the expanded name
-- is an Lvalue, but the prefix is never an Lvalue, since it is just -- is an lvalue, but the prefix is never an lvalue, since it is just
-- the scope where the name is found. -- the scope where the name is found.
when N_Expanded_Name => when N_Expanded_Name =>
...@@ -7287,11 +7287,11 @@ package body Sem_Util is ...@@ -7287,11 +7287,11 @@ package body Sem_Util is
return False; return False;
end if; end if;
-- For a selected component A.B, A is certainly an Lvalue if A.B is -- For a selected component A.B, A is certainly an lvalue if A.B is.
-- an Lvalue. B is a little interesting, if we have A.B:=3, there is -- B is a little interesting, if we have A.B := 3, there is some
-- some discussion as to whether B is an Lvalue or not, we choose to -- discussion as to whether B is an lvalue or not, we choose to say
-- say it is. Note however that A is not an Lvalue if it is of an -- it is. Note however that A is not an lvalue if it is of an access
-- access type since this is an implicit dereference. -- type since this is an implicit dereference.
when N_Selected_Component => when N_Selected_Component =>
if N = Prefix (P) if N = Prefix (P)
...@@ -7304,8 +7304,8 @@ package body Sem_Util is ...@@ -7304,8 +7304,8 @@ package body Sem_Util is
end if; end if;
-- For an indexed component or slice, the index or slice bounds is -- For an indexed component or slice, the index or slice bounds is
-- never an Lvalue. The prefix is an Lvalue if the indexed component -- never an lvalue. The prefix is an lvalue if the indexed component
-- or slice is an Lvalue, except if it is an access type, where we -- or slice is an lvalue, except if it is an access type, where we
-- have an implicit dereference. -- have an implicit dereference.
when N_Indexed_Component => when N_Indexed_Component =>
...@@ -7317,17 +7317,17 @@ package body Sem_Util is ...@@ -7317,17 +7317,17 @@ package body Sem_Util is
return May_Be_Lvalue (P); return May_Be_Lvalue (P);
end if; end if;
-- Prefix of a reference is an Lvalue if the reference is an Lvalue -- Prefix of a reference is an lvalue if the reference is an lvalue
when N_Reference => when N_Reference =>
return May_Be_Lvalue (P); return May_Be_Lvalue (P);
-- Prefix of explicit dereference is never an Lvalue -- Prefix of explicit dereference is never an lvalue
when N_Explicit_Dereference => when N_Explicit_Dereference =>
return False; return False;
-- Function call arguments are never Lvalues -- Function call arguments are never lvalues
when N_Function_Call => when N_Function_Call =>
return False; return False;
...@@ -7414,7 +7414,7 @@ package body Sem_Util is ...@@ -7414,7 +7414,7 @@ package body Sem_Util is
end; end;
-- Test for appearing in a conversion that itself appears in an -- Test for appearing in a conversion that itself appears in an
-- Lvalue context, since this should be an Lvalue. -- lvalue context, since this should be an lvalue.
when N_Type_Conversion => when N_Type_Conversion =>
return May_Be_Lvalue (P); return May_Be_Lvalue (P);
...@@ -7424,7 +7424,7 @@ package body Sem_Util is ...@@ -7424,7 +7424,7 @@ package body Sem_Util is
when N_Object_Renaming_Declaration => when N_Object_Renaming_Declaration =>
return True; return True;
-- All other references are definitely not Lvalues -- All other references are definitely not lvalues
when others => when others =>
return False; return False;
......
...@@ -475,7 +475,7 @@ package body Sem_Warn is ...@@ -475,7 +475,7 @@ package body Sem_Warn is
and then Present (Entity (N)) and then Present (Entity (N))
and then Entity (N) = Var and then Entity (N) = Var
then then
-- If this is an Lvalue, then definitely abandon, since -- If this is an lvalue, then definitely abandon, since
-- this could be a direct modification of the variable. -- this could be a direct modification of the variable.
if May_Be_Lvalue (N) then if May_Be_Lvalue (N) then
......
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