+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>
* exp_ch7.adb: Update comments.
-- an atomic move for it.
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 Expand_Atomic_Aggregate (N, Typ)
then
- Expand_Atomic_Aggregate (N, Typ);
return;
-- No special management required for aggregates used to initialize
-- resulting variable is a temporary which does not designate
-- the proper out-parameter, which may not be addressable. In
-- 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.
declare
end if;
-- 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.
Analyze (N);
-- 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);
New_N : Node_Id;
+ Par : Node_Id;
Temp : Entity_Id;
begin
- if (Nkind (Parent (E)) = N_Object_Declaration
- or else Nkind (Parent (E)) = N_Assignment_Statement)
- and then Comes_From_Source (Parent (E))
+ Par := 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
Temp :=
Make_Defining_Identifier (Loc,
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (E));
- Insert_Before (Parent (E), New_N);
+ Insert_Before (Par, 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 Expand_Atomic_Aggregate;
and then Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E)))
and then Nkind (Expression (Parent (E))) = N_Aggregate
+ and then
+ Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E))
then
- Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E));
+ null;
end if;
-- For a subprogram, freeze all parameter types and also the return
-- do not allow a size clause if the size would not otherwise be known at
-- 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
-- an aggregate, we have to prevent a piecemeal access or assignment
-- to the object, even if the aggregate is to be expanded. We create
-- 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;
-- Freeze an entity, and return Freeze nodes, to be inserted at the
No_File_Found : constant File_Found := (No_File, False, No_Location);
-- 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,
Element => File_Found,
No_Element => No_File_Found,
-- Find_Excluded_Sources below.
procedure Find_Excluded_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref);
+ (Project : Project_Id;
+ 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
-- for this project. Sets the list in the Excluded_Sources_Htable.
-- with a file name following the naming convention.
procedure Load_Naming_Exceptions
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Excluded : in out Excluded_Sources_Htable.Instance);
-- All source files in Data.First_Source are considered as naming
-- exceptions, and copied into the Source_Names and Unit_Exceptions tables
-- as appropriate.
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
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
-- True, check each regular file name against the naming schemes of the
-- different languages. Otherwise consider only the file names in the hash
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
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
-- list of source files into the Source_Names htable. When these attributes
-- are not defined, find all files matching the naming schemes in the
---------------------------
procedure Find_Excluded_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Excluded : in out Excluded_Sources_Htable.Instance)
is
Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree);
end if;
- Excluded_Sources_Htable.Reset;
+ Excluded_Sources_Htable.Reset (Excluded);
-- If there are excluded sources, put them in the table
Location := Element.Location;
end if;
- Excluded_Sources_Htable.Set (Name, (Name, False, Location));
+ Excluded_Sources_Htable.Set
+ (Excluded, Name, (Name, False, Location));
Current := Element.Next;
end loop;
end loop;
Excluded_Sources_Htable.Set
- (Name, (Name, False, Location));
+ (Excluded, Name, (Name, False, Location));
end if;
end loop;
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Proc_Data : in out Processing_Data;
- Allow_Duplicate_Basenames : Boolean)
+ Allow_Duplicate_Basenames : Boolean;
+ Excluded : in out Excluded_Sources_Htable.Instance)
is
Sources : constant Variable_Value :=
Util.Value_Of
(Project, In_Tree,
For_All_Sources =>
Sources.Default and then Source_List_File.Default,
- Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
+ Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
+ Excluded => Excluded);
end if;
-- Check if all exceptions have been found. For Ada, it is an error if
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
For_All_Sources : Boolean;
- Allow_Duplicate_Basenames : Boolean)
+ Allow_Duplicate_Basenames : Boolean;
+ Excluded : in out Excluded_Sources_Htable.Instance)
is
Source_Dir : String_List_Id;
Element : String_Element;
-- Case_Sensitive set True (no folding)
Path : Path_Name_Type;
- FF : File_Found :=
- Excluded_Sources_Htable.Get (File_Name);
+ FF : File_Found := Excluded_Sources_Htable.Get
+ (Excluded, File_Name);
begin
Name_Len := Path_Name'Length;
if FF /= No_File_Found then
if not FF.Found then
FF.Found := True;
- Excluded_Sources_Htable.Set (File_Name, FF);
+ Excluded_Sources_Htable.Set
+ (Excluded, File_Name, FF);
if Current_Verbosity = High then
Write_Str (" excluded source """);
----------------------------
procedure Load_Naming_Exceptions
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Excluded : in out Excluded_Sources_Htable.Instance)
is
Source : Source_Id;
Iter : Source_Iterator;
-- 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
(Project, In_Tree,
Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean)
is
- Iter : Source_Iterator;
+ Iter : Source_Iterator;
+ Src : Source_Id;
+ Excluded_Sources : Excluded_Sources_Htable.Instance;
procedure Process_Sources_In_Multi_Language_Mode;
-- Find all source files when in multi language mode
procedure Mark_Excluded_Sources is
Source : Source_Id := No_Source;
- OK : Boolean;
Excluded : File_Found;
-
+ Proj : Project_Id;
begin
- Excluded := Excluded_Sources_Htable.Get_First;
- while Excluded /= No_File_Found loop
- OK := False;
+ Proj := Project;
+ while Proj /= No_Project loop
+ 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?
- -- ??? Why can't simply iterate over the sources of the current
- -- project, as opposed to the whole tree ?
+ if Current_Verbosity = High then
+ Write_Str ("Removing file ");
+ Write_Line
+ (Get_Name_String (Excluded.File)
+ & " " & Get_Name_String (Source.Project.Name));
+ end if;
- Iter := For_Each_Source (In_Tree);
- loop
- Source := Prj.Element (Iter);
- exit when Source = No_Source;
+ Excluded_Sources_Htable.Remove
+ (Excluded_Sources, Source.File);
+ end if;
- if Source.File = Excluded.File then
- if Source.Project = Project
- or else Is_Extending (Project, Source.Project)
- then
- OK := True;
- Source.Locally_Removed := True;
- Source.In_Interfaces := False;
+ Next (Iter);
+ end loop;
- if Current_Verbosity = High then
- Write_Str ("Removing file ");
- Write_Line
- (Get_Name_String (Excluded.File)
- & " " & Get_Name_String (Source.Project.Name));
- end if;
+ Proj := Proj.Extends;
+ end loop;
- else
- Error_Msg
- (Project, In_Tree,
- "cannot remove a source from another project",
- Excluded.Location);
- end if;
+ -- If we have any excluded element left, that means we did not find
+ -- the source file
- -- We used to exit here, but in fact when a source is
- -- overridden in an extended project we have only marked the
- -- 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
+ Excluded := Excluded_Sources_Htable.Get_First (Excluded_Sources);
+ while Excluded /= No_File_Found loop
- -- exit;
- end if;
+ -- Check if the file belongs to another imported project to
+ -- provide a better error message.
- Next (Iter);
- end loop;
+ Src := Find_Source
+ (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
- Err_Vars.Error_Msg_File_1 := Excluded.File;
+ if Src = No_Source then
Error_Msg
(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;
- Excluded := Excluded_Sources_Htable.Get_Next;
+ Excluded := Excluded_Sources_Htable.Get_Next (Excluded_Sources);
end loop;
end Mark_Excluded_Sources;
begin
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))
or else (Get_Mode = Multi_Language
and then Project.Languages /= No_Language_Index)
then
if Get_Mode = Multi_Language then
- Load_Naming_Exceptions (Project, In_Tree);
+ Load_Naming_Exceptions (Project, In_Tree, Excluded_Sources);
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;
if Get_Mode = Multi_Language then
Reset (Seen);
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 --
--------------
procedure Next (Iter : in out Source_Iterator);
-- 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 --
-----------------------
-- Generate cross-reference. We needed to wait until full overloading
-- 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
Generate_Reference (Entity (S), S, 'm');
when N_Assignment_Statement =>
return N = Name (P);
- -- Function call arguments are never Lvalues
+ -- Function call arguments are never lvalues
when N_Function_Call =>
return False;
end;
-- 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 =>
return Known_To_Be_Assigned (P);
return N = Prefix (P)
and then Name_Implies_Lvalue_Prefix (Attribute_Name (P));
- -- 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
+ -- 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
-- the scope where the name is found.
when N_Expanded_Name =>
return False;
end if;
- -- 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
- -- some discussion as to whether B is an Lvalue or not, we choose to
- -- say it is. Note however that A is not an Lvalue if it is of an
- -- access type since this is an implicit dereference.
+ -- For a selected component A.B, A is certainly an lvalue if A.B is.
+ -- B is a little interesting, if we have A.B := 3, there is some
+ -- discussion as to whether B is an lvalue or not, we choose to say
+ -- it is. Note however that A is not an lvalue if it is of an access
+ -- type since this is an implicit dereference.
when N_Selected_Component =>
if N = Prefix (P)
end if;
-- For an indexed component or slice, the index or slice bounds is
- -- 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
+ -- 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
-- have an implicit dereference.
when N_Indexed_Component =>
return May_Be_Lvalue (P);
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 =>
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 =>
return False;
- -- Function call arguments are never Lvalues
+ -- Function call arguments are never lvalues
when N_Function_Call =>
return False;
end;
-- 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 =>
return May_Be_Lvalue (P);
when N_Object_Renaming_Declaration =>
return True;
- -- All other references are definitely not Lvalues
+ -- All other references are definitely not lvalues
when others =>
return False;
and then Present (Entity (N))
and then Entity (N) = Var
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.
if May_Be_Lvalue (N) then
projects / platform / upstream / gcc.git / commitdiff