+2016-06-14 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * lib.adb: Minor reformatting.
+ * sem_util.adb (Is_OK_Volatile_Context): Do
+ include Address in the supported attributes.
+
+2016-06-14 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Case_Expression):
+ Code cleanup. Finalize any transient controlled
+ objects on exit from a case expression alternative.
+ (Expand_N_If_Expression): Code cleanup.
+ (Process_Actions): Removed.
+ (Process_If_Case_Statements): New routine.
+ (Process_Transient_Object): Change the name of formal Rel_Node to
+ N and update all occurrences. Update the comment on usage. When
+ the type of the context is Boolean, the proper insertion point
+ for the finalization call is after the last declaration.
+
+2016-06-14 Ed Schonberg <schonberg@adacore.com>
+
+ * lib-xref.ads, lib-xref.adb (Has_Deferred_Reference): new
+ predicate to determine whether an entity appears in a context
+ for which a Deferred_Reference was created, because it is not
+ possible to determine when reference is analyzed whether it
+ appears in a context in which the entity is modified.
+ * sem_ch5.adb (Analyze_Statement): Do not emit a useless warning
+ on assignment for an entity that has a deferred_reference.
+
+2016-06-14 Javier Miranda <miranda@adacore.com>
+
+ * sem_res.adb (Resolve_Actuals): Generate a reference to actuals that
+ come from source. Previously the reference was generated only if the
+ call comes from source but the call may be rewritten by the expander
+ thus causing the notification of spurious warnings.
+
+2016-06-14 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb: Remove further references to AAMP.
+ * checks.adb (Apply_Scalar_Range_Check): Take
+ Check_Float_Overflow info account.
+ * live.ads, live.adb Added subprogram headers and
+ start-of-processing-for comments.
+ * sem_ch12.adb (Instantiate_Package_Body): Do not suppress
+ checks when instantiating runtime units in CodePeer mode.
+
2016-06-14 Arnaud Charlet <charlet@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Only consider
-- Floating-point case
-- In the floating-point case, we only do range checks if the type is
-- constrained. We definitely do NOT want range checks for unconstrained
- -- types, since we want to have infinities
+ -- types, since we want to have infinities, except when
+ -- Check_Float_Overflow is set.
elsif Is_Floating_Point_Type (S_Typ) then
-
- -- Normally, we only do range checks if the type is constrained. We do
- -- NOT want range checks for unconstrained types, since we want to have
- -- infinities.
-
- if Is_Constrained (S_Typ) then
+ if Is_Constrained (S_Typ) or else Check_Float_Overflow then
Enable_Range_Check (Expr);
end if;
-- simple entity, and op is a comparison operator, optimizes it into a
-- comparison of First and Last.
- procedure Process_Transient_Object
- (Decl : Node_Id;
- Rel_Node : Node_Id);
- -- Subsidiary routine to the expansion of expression_with_actions and if
- -- expressions. Generate all the necessary code to finalize a transient
+ procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id);
+ -- Inspect and process statement list Stmt of if or case expression N for
+ -- transient controlled objects. If such objects are found, the routine
+ -- generates code to clean them up when the context of the expression is
+ -- evaluated or elaborated.
+
+ procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id);
+ -- Subsidiary routine to the expansion of expression_with_actions, if and
+ -- case expressions. Generate all necessary code to finalize a transient
-- controlled object when the enclosing context is elaborated or evaluated.
-- Decl denotes the declaration of the transient controlled object which is
- -- usually the result of a controlled function call. Rel_Node denotes the
- -- context, either an expression_with_actions or an if expression.
+ -- usually the result of a controlled function call. N denotes the related
+ -- expression_with_actions, if expression, or case expression.
procedure Rewrite_Comparison (N : Node_Id);
-- If N is the node for a comparison whose outcome can be determined at
------------------------------
procedure Expand_N_Case_Expression (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Acts : List_Id;
- Alt : Node_Id;
- Case_Stmt : Node_Id;
- Decl : Node_Id;
- Expr : Node_Id;
- In_Predicate : Boolean := False;
+ Loc : constant Source_Ptr := Sloc (N);
+ Par : constant Node_Id := Parent (N);
+ Typ : constant Entity_Id := Etype (N);
+ Acts : List_Id;
+ Alt : Node_Id;
+ Case_Stmt : Node_Id;
+ Decl : Node_Id;
+ Expr : Node_Id;
+ Target : Entity_Id;
+ Target_Typ : Entity_Id;
+
+ In_Predicate : Boolean := False;
+ -- Flag set when the case expression appears within a predicate
+
Optimize_Return_Stmt : Boolean := False;
- Par : Node_Id;
- Ptr_Typ : Entity_Id;
- Target : Entity_Id;
- Target_Typ : Entity_Id;
+ -- Flag set when the case expression can be optimized in the context of
+ -- a simple return statement.
begin
-- Check for MINIMIZED/ELIMINATED overflow mode
end if;
end if;
- -- We expand
+ -- When the type of the case expression is elementary, expand
- -- case X is when A => AX, when B => BX ...
+ -- (case X is when A => AX, when B => BX ...)
- -- to
+ -- into
-- do
- -- Target : typ;
+ -- Target : Typ;
-- case X is
-- when A =>
-- Target := AX;
-- end case;
-- in Target end;
- -- Except when the case expression appears as part of a simple return
- -- statement, returning an elementary type, where we expand
-
- -- return (case X is when A => AX, when B => BX ...)
-
- -- to
-
- -- case X is
- -- when A =>
- -- return AX;
- -- when B =>
- -- return BX;
- -- ...
- -- end case;
-
- -- Note that this expansion is also triggered for expression functions
- -- containing a single case expression since these functions are
- -- expanded as above.
-
- -- However, this expansion is wrong for limited types, and also wrong
- -- for unconstrained types (since the bounds may not be the same in all
- -- branches). Furthermore it involves an extra copy for large objects.
- -- So we take care of this by using the following modified expansion for
- -- non-elementary types:
+ -- In all other cases expand into
-- do
- -- type Ptr_Typ is access all typ;
+ -- type Ptr_Typ is access all Typ;
-- Target : Ptr_Typ;
-- case X is
-- when A =>
-- end case;
-- in Target.all end;
+ -- This approach avoids extra copies of potentially large objects. It
+ -- also allows handling of values of limited or unconstrained types.
+
+ -- Small optimization: when the case expression appears in the context
+ -- of a simple return statement, expand into
+
+ -- case X is
+ -- when A =>
+ -- return AX;
+ -- when B =>
+ -- return BX;
+ -- ...
+ -- end case;
+
Case_Stmt :=
Make_Case_Statement (Loc,
Expression => Expression (N),
Target_Typ := Typ;
-- ??? Do not perform the optimization when the return statement is
- -- within a predicate function as this causes supurious errors. A
- -- possible mismatch in handling this case somewhere else in semantic
- -- analysis?
+ -- within a predicate function as this causes supurious errors. Could
+ -- this be a possible mismatch in handling this case somewhere else
+ -- in semantic analysis?
- if not In_Predicate
- and then Nkind (Parent (N)) = N_Simple_Return_Statement
- then
- Optimize_Return_Stmt := True;
- end if;
+ Optimize_Return_Stmt :=
+ Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+
+ -- Otherwise create an access type to handle the general case using
+ -- 'Unrestricted_Access.
+
+ -- Generate:
+ -- type Ptr_Typ is access all Typ;
else
- Ptr_Typ := Make_Temporary (Loc, 'P');
+ Target_Typ := Make_Temporary (Loc, 'P');
+
Append_To (Acts,
Make_Full_Type_Declaration (Loc,
- Defining_Identifier => Ptr_Typ,
+ Defining_Identifier => Target_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication => New_Occurrence_Of (Typ, Loc))));
- Target_Typ := Ptr_Typ;
end if;
+ -- Create the declaration of the target which captures the value of the
+ -- expression.
+
+ -- Generate:
+ -- Target : [Ptr_]Typ;
+
if not Optimize_Return_Stmt then
Target := Make_Temporary (Loc, 'T');
- -- Create declaration for target of expression, and indicate that it
- -- does not require initialization.
-
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Target,
Object_Definition => New_Occurrence_Of (Target_Typ, Loc));
Set_No_Initialization (Decl);
+
Append_To (Acts, Decl);
end if;
- -- Now process the alternatives
+ -- Process the alternatives
Alt := First (Alternatives (N));
while Present (Alt) loop
Stmts : List_Id;
begin
- -- As described above, take Unrestricted_Access for case of non-
- -- scalar types, to avoid big copies, and special cases.
+ -- Take the unrestricted access of the expression value for non-
+ -- scalar types. This approach avoids big copies and covers the
+ -- limited and unconstrained cases.
+
+ -- Generate:
+ -- AX'Unrestricted_Access
if not Is_Elementary_Type (Typ) then
Alt_Expr :=
Attribute_Name => Name_Unrestricted_Access);
end if;
+ -- Generate:
+ -- return AX['Unrestricted_Access];
+
if Optimize_Return_Stmt then
Stmts := New_List (
Make_Simple_Return_Statement (Alt_Loc,
Expression => Alt_Expr));
+
+ -- Generate:
+ -- Target := AX['Unrestricted_Access];
+
else
Stmts := New_List (
Make_Assignment_Statement (Alt_Loc,
Prepend_List (Actions (Alt), Stmts);
end if;
+ -- Finalize any transient controlled objects on exit from the
+ -- alternative. This is done only in the return optimization case
+ -- because otherwise the case expression is converted into an
+ -- expression with actions which already contains this form of
+ -- processing.
+
+ if Optimize_Return_Stmt then
+ Process_If_Case_Statements (N, Stmts);
+ end if;
+
Append_To
(Alternatives (Case_Stmt),
Make_Case_Statement_Alternative (Sloc (Alt),
Next (Alt);
end loop;
- -- Rewrite parent return statement as a case statement if possible
+ -- Rewrite the parent return statement as a case statement
if Optimize_Return_Stmt then
- Par := Parent (N);
Rewrite (Par, Case_Stmt);
Analyze (Par);
- return;
- end if;
-
- Append_To (Acts, Case_Stmt);
- -- Construct and return final expression with actions
+ -- Otherwise convert the case expression into an expression with actions
- if Is_Elementary_Type (Typ) then
- Expr := New_Occurrence_Of (Target, Loc);
else
- Expr :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (Target, Loc));
- end if;
+ Append_To (Acts, Case_Stmt);
- Rewrite (N,
- Make_Expression_With_Actions (Loc,
- Expression => Expr,
- Actions => Acts));
+ if Is_Elementary_Type (Typ) then
+ Expr := New_Occurrence_Of (Target, Loc);
- Analyze_And_Resolve (N, Typ);
+ else
+ Expr :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Target, Loc));
+ end if;
+
+ -- Generate:
+ -- do
+ -- ...
+ -- in Target[.all] end;
+
+ Rewrite (N,
+ Make_Expression_With_Actions (Loc,
+ Expression => Expr,
+ Actions => Acts));
+
+ Analyze_And_Resolve (N, Typ);
+ end if;
end Expand_N_Case_Expression;
-----------------------------------
-- Deal with limited types and condition actions
procedure Expand_N_If_Expression (N : Node_Id) is
- procedure Process_Actions (Actions : List_Id);
- -- Inspect and process a single action list of an if expression for
- -- transient controlled objects. If such objects are found, the routine
- -- generates code to clean them up when the context of the expression is
- -- evaluated or elaborated.
-
- ---------------------
- -- Process_Actions --
- ---------------------
-
- procedure Process_Actions (Actions : List_Id) is
- Act : Node_Id;
-
- begin
- Act := First (Actions);
- while Present (Act) loop
- if Nkind (Act) = N_Object_Declaration
- and then Is_Finalizable_Transient (Act, N)
- then
- Process_Transient_Object (Act, N);
- end if;
-
- Next (Act);
- end loop;
- end Process_Actions;
-
- -- Local variables
-
- Loc : constant Source_Ptr := Sloc (N);
- Cond : constant Node_Id := First (Expressions (N));
- Thenx : constant Node_Id := Next (Cond);
- Elsex : constant Node_Id := Next (Thenx);
- Typ : constant Entity_Id := Etype (N);
+ Cond : constant Node_Id := First (Expressions (N));
+ Loc : constant Source_Ptr := Sloc (N);
+ Thenx : constant Node_Id := Next (Cond);
+ Elsex : constant Node_Id := Next (Thenx);
+ Typ : constant Entity_Id := Etype (N);
Actions : List_Id;
Cnn : Entity_Id;
New_N : Node_Id;
Ptr_Typ : Entity_Id;
- -- Start of processing for Expand_N_If_Expression
-
begin
-- Check for MINIMIZED/ELIMINATED overflow mode
if Compile_Time_Known_Value (Cond) then
declare
function Fold_Known_Value (Cond : Node_Id) return Boolean;
- -- Fold at compile time. Assumes condition known.
- -- Return True if folding occurred, meaning we're done.
+ -- Fold at compile time. Assumes condition known. Return True if
+ -- folding occurred, meaning we're done.
----------------------
-- Fold_Known_Value --
-- of actions. These temporaries need to be finalized after the if
-- expression is evaluated.
- Process_Actions (Then_Actions (N));
- Process_Actions (Else_Actions (N));
+ Process_If_Case_Statements (N, Then_Actions (N));
+ Process_If_Case_Statements (N, Else_Actions (N));
-- Generate:
-- type Ann is access all Typ;
return;
end Optimize_Length_Comparison;
+ --------------------------------
+ -- Process_If_Case_Statements --
+ --------------------------------
+
+ procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id) is
+ Decl : Node_Id;
+
+ begin
+ Decl := First (Stmts);
+ while Present (Decl) loop
+ if Nkind (Decl) = N_Object_Declaration
+ and then Is_Finalizable_Transient (Decl, N)
+ then
+ Process_Transient_Object (Decl, N);
+ end if;
+
+ Next (Decl);
+ end loop;
+ end Process_If_Case_Statements;
+
------------------------------
-- Process_Transient_Object --
------------------------------
- procedure Process_Transient_Object
- (Decl : Node_Id;
- Rel_Node : Node_Id)
- is
- Loc : constant Source_Ptr := Sloc (Decl);
- Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
- Obj_Typ : constant Node_Id := Etype (Obj_Id);
+ procedure Process_Transient_Object (Decl : Node_Id; N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (Decl);
+ Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
+ Obj_Typ : constant Node_Id := Etype (Obj_Id);
+
Desig_Typ : Entity_Id;
Expr : Node_Id;
Hook_Id : Entity_Id;
Hook_Insert : Node_Id;
Ptr_Id : Entity_Id;
- Hook_Context : constant Node_Id := Find_Hook_Context (Rel_Node);
+ Hook_Context : constant Node_Id := Find_Hook_Context (N);
-- The node on which to insert the hook as an action. This is usually
-- the innermost enclosing non-transient construct.
-- transient controlled object.
begin
- if Is_Boolean_Type (Etype (Rel_Node)) then
- Fin_Context := Last (Actions (Rel_Node));
+ if Is_Boolean_Type (Etype (N)) then
+ Fin_Context := Last (List_Containing (Decl));
else
Fin_Context := Hook_Context;
end if;
if Debug_Flag_Dot_LL then
Back_End_Handles_Limited_Types := True;
- -- If no debug flag, usage off for AAMP, SCIL cases
+ -- If no debug flag, usage off for SCIL cases
- elsif AAMP_On_Target
- or else Generate_SCIL
- then
+ elsif Generate_SCIL then
Back_End_Handles_Limited_Types := False;
-- Otherwise normal gcc back end, for now still turn flag off by
-- back end some day, it would not be true for this test, but it
-- would be non-GCC, so this is a bit troublesome ???
- Front_End_Inlining := AAMP_On_Target or Generate_C_Code;
+ Front_End_Inlining := Generate_C_Code;
end if;
-- Set back-end inlining indication
Back_End_Inlining :=
- -- No back-end inlining available on AAMP
-
- not AAMP_On_Target
-
-- No back-end inlining available on C generation
- and then not Generate_C_Code
+ not Generate_C_Code
-- No back-end inlining in GNATprove mode, since it just confuses
-- the formal verification process.
return E;
end Get_Key;
+ ----------------------------
+ -- Has_Deferred_Reference --
+ ----------------------------
+
+ function Has_Deferred_Reference (Ent : Entity_Id) return Boolean is
+ begin
+ for J in Deferred_References.First .. Deferred_References.Last loop
+ if Deferred_References.Table (J).E = Ent then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end Has_Deferred_Reference;
+
----------
-- Hash --
----------
procedure Process_Deferred_References;
-- This procedure is called from Frontend to process these table entries
+ function Has_Deferred_Reference (Ent : Entity_Id) return Boolean;
+ -- This function determines whether an entity has a pending reference, in
+ -- order to suppress premature warnings about useless assignments. See
+ -- comments in Analyze_Assignment in sem-ch5.adb.
+
-----------------------------
-- SPARK Xrefs Information --
-----------------------------
(S : Source_Ptr;
Unwind_Instances : Boolean;
Unwind_Subunits : Boolean) return Unit_Number_Type;
- -- Common code for Get_Code_Unit (get unit of instantiation for
- -- location) Get_Source_Unit (get unit of template for location) and
- -- Get_Top_Level_Code_Unit (same as Get_Code_Unit but not stopping at
- -- subunits).
+ -- Common processing for routines Get_Code_Unit, Get_Source_Unit, and
+ -- Get_Top_Level_Code_Unit. Unwind_Instances is True when the unit for the
+ -- top-level instantiation should be returned instead of the unit for the
+ -- template, in the case of an instantiation. Unwind_Subunits is True when
+ -- the corresponding top-level unit should be returned instead of a
+ -- subunit, in the case of a subunit.
--------------------------------------------
-- Access Functions for Unit Table Fields --
function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
begin
- return Get_Code_Or_Source_Unit (Top_Level_Location (S),
- Unwind_Instances => False, Unwind_Subunits => False);
+ return
+ Get_Code_Or_Source_Unit
+ (Top_Level_Location (S),
+ Unwind_Instances => False,
+ Unwind_Subunits => False);
end Get_Code_Unit;
function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
begin
if N <= Compilation_Switches.Last then
return Compilation_Switches.Table (N);
-
else
return null;
end if;
function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is
begin
- return Get_Code_Or_Source_Unit (S,
- Unwind_Instances => True, Unwind_Subunits => False);
+ return
+ Get_Code_Or_Source_Unit
+ (S, Unwind_Instances => True, Unwind_Subunits => False);
end Get_Source_Unit;
function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
function Get_Top_Level_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
begin
- return Get_Code_Or_Source_Unit (Top_Level_Location (S),
- Unwind_Instances => False, Unwind_Subunits => True);
+ return
+ Get_Code_Or_Source_Unit
+ (Top_Level_Location (S),
+ Unwind_Instances => False,
+ Unwind_Subunits => True);
end Get_Top_Level_Code_Unit;
function Get_Top_Level_Code_Unit
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2016, Free Software Foundation, Inc. --
-- --
-- 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- --
-- Name_Set
- -- The Name_Set type is used to store the temporary mark bits
- -- used by the garbage collection of entities. Using a separate
- -- array prevents using up any valuable per-node space and possibly
- -- results in better locality and cache usage.
+ -- The Name_Set type is used to store the temporary mark bits used by the
+ -- garbage collection of entities. Using a separate array prevents using up
+ -- any valuable per-node space and possibly results in better locality and
+ -- cache usage.
type Name_Set is array (Node_Id range <>) of Boolean;
pragma Pack (Name_Set);
-- The Mark phase is split into two phases:
procedure Init_Marked (Root : Node_Id; Marks : out Name_Set);
- -- For all subprograms, reset Is_Public flag if a pragma Eliminate
- -- applies to the entity, and set the Marked flag to Is_Public
+ -- For all subprograms, reset Is_Public flag if a pragma Eliminate applies
+ -- to the entity, and set the Marked flag to Is_Public.
procedure Trace_Marked (Root : Node_Id; Marks : in out Name_Set);
- -- Traverse the tree skipping any unmarked subprogram bodies.
- -- All visited entities are marked, as well as entities denoted
- -- by a visited identifier or operator. When an entity is first
- -- marked it is traced as well.
+ -- Traverse the tree skipping any unmarked subprogram bodies. All visited
+ -- entities are marked, as well as entities denoted by a visited identifier
+ -- or operator. When an entity is first marked it is traced as well.
-- Local functions
function Process (N : Node_Id) return Traverse_Result;
procedure Traverse is new Traverse_Proc (Process);
+ -------------
+ -- Process --
+ -------------
+
function Process (N : Node_Id) return Traverse_Result is
begin
case Nkind (N) is
function Process (N : Node_Id) return Traverse_Result;
procedure Traverse is new Traverse_Proc (Process);
+ -------------
+ -- Process --
+ -------------
+
function Process (N : Node_Id) return Traverse_Result is
begin
case Nkind (N) is
return OK;
end Process;
+ -- Start of processing for Sweep
+
begin
Traverse (Root);
end Sweep;
procedure Process (N : Node_Id);
procedure Traverse is new Traverse_Proc (Process);
+ -------------
+ -- Process --
+ -------------
+
procedure Process (N : Node_Id) is
Result : Traverse_Result;
pragma Warnings (Off, Result);
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2016, Free Software Foundation, Inc. --
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- This package implements a compiler phase that determines the set
--- of live entities. For now entities are considered live when they
--- have at least one execution time reference.
+-- This package implements a compiler phase that determines the set of live
+-- entities. For now entities are considered live when they have at least one
+-- execution time reference.
package Live is
procedure Collect_Garbage_Entities;
- -- Eliminate unreachable entities using a mark-and-sweep from
- -- the set of root entities, i.e. those having Is_Public set.
+ -- Eliminate unreachable entities using a mark-and-sweep from the set of
+ -- root entities, i.e. those having Is_Public set.
end Live;
-- Note that we do NOT apply this criterion to children of GNAT
-- The latter units must suppress checks explicitly if needed.
- if Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Gen_Decl)))
+ -- We also do not suppress checks in CodePeer mode where we are
+ -- interested in finding possible runtime errors.
+
+ if not CodePeer_Mode
+ and then Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Gen_Decl)))
then
Analyze (Act_Body, Suppress => All_Checks);
else
-- warnings when an assignment is rewritten as another
-- assignment, and gets tied up with itself.
+ -- There may have been a previous reference to a component of
+ -- the variable, which in general removes the Last_Assignment
+ -- field of the variable to indicate a relevant use of the
+ -- previous assignment. However, if the assignment is to a
+ -- subcomponent the reference may not have registered, because
+ -- it is not possible to determine whether the context is an
+ -- assignment. In those cases we generate a Deferred_Reference,
+ -- to be used at the end of compilation to generate the right
+ -- kind of reference, and we suppress a potential warning for
+ -- a useless assignment, which might be premature. This may
+ -- lose a warning in rare cases, but seems preferable to a
+ -- misleading warning.
+
if Warn_On_Modified_Unread
and then Is_Assignable (Ent)
and then Comes_From_Source (N)
and then In_Extended_Main_Source_Unit (Ent)
+ and then not Has_Deferred_Reference (Ent)
then
Warn_On_Useless_Assignment (Ent, N);
end if;
if Present (A)
and then Is_Entity_Name (A)
- and then Comes_From_Source (N)
+ and then Comes_From_Source (A)
then
Orig_A := Entity (A);
elsif Nkind (Context) = N_Attribute_Reference
and then Prefix (Context) = Obj_Ref
- and then Nam_In (Attribute_Name (Context), Name_Alignment,
+ and then Nam_In (Attribute_Name (Context), Name_Address,
+ Name_Alignment,
Name_Component_Size,
Name_First_Bit,
Name_Last_Bit,
projects / gcc.git / commitdiff