Unit_Name : Node_Id;
Success : Boolean;
- pragma Unreferenced (Success);
+ pragma Warnings (Off, "modified by call");
procedure Decode_Name_Buffer;
-- Replace "__" by "." in Name_Buffer, and adjust Name_Len accordingly
The left hand side of an assignment does not count as a reference for the
purpose of this pragma. Thus it is fine to assign to an entity for which
-pragma Unreferenced is given.
+pragma Unreferenced is given. However, use of an entity as an actual for
+an out parameter does count as a reference unless warnings for unread output
+parameters are enabled via :switch:`-gnatw.o`.
Note that if a warning is desired for all calls to a given subprogram,
regardless of whether they occur in the same unit as the subprogram
else
Set_At;
Set_Msg_Str ("line ");
- Int_File := False;
Set_Msg_Int (Int (Get_Logical_Line_Number (Loc)));
end if;
-- Do not replace lvalues
- and then not May_Be_Lvalue (N)
+ and then not Known_To_Be_Assigned (N)
-- Check that entity is suitable for replacement
and then Is_Scalar_Type (Etype (N))
and then (Is_Assignable (E) or else Is_Constant_Object (E))
and then Comes_From_Source (N)
- and then Is_LHS (N) = No
+ and then not Known_To_Be_Assigned (N)
and then not Is_Actual_Out_Parameter (N)
and then (Nkind (Parent (N)) /= N_Attribute_Reference
or else Attribute_Name (Parent (N)) /= Name_Valid)
Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack));
P_Comp_Ref : Entity_Id;
- function In_Assignment_Context (N : Node_Id) return Boolean;
- -- Check whether this is a context in which the entry formal may be
- -- assigned to.
-
- ---------------------------
- -- In_Assignment_Context --
- ---------------------------
-
- function In_Assignment_Context (N : Node_Id) return Boolean is
- begin
- -- Case of use in a call
-
- -- ??? passing a formal as actual for a mode IN formal is
- -- considered as an assignment?
-
- if Nkind (Parent (N)) in
- N_Procedure_Call_Statement | N_Entry_Call_Statement
- or else (Nkind (Parent (N)) = N_Assignment_Statement
- and then N = Name (Parent (N)))
- then
- return True;
-
- -- Case of a parameter association: climb up to enclosing call
-
- elsif Nkind (Parent (N)) = N_Parameter_Association then
- return In_Assignment_Context (Parent (N));
-
- -- Case of a selected component, indexed component or slice prefix:
- -- climb up the tree, unless the prefix is of an access type (in
- -- which case there is an implicit dereference, and the formal itself
- -- is not being assigned to).
-
- elsif Nkind (Parent (N)) in
- N_Selected_Component | N_Indexed_Component | N_Slice
- and then N = Prefix (Parent (N))
- and then not Is_Access_Type (Etype (N))
- and then In_Assignment_Context (Parent (N))
- then
- return True;
-
- else
- return False;
- end if;
- end In_Assignment_Context;
-
-- Start of processing for Expand_Entry_Parameter
begin
-- done during semantic processing so it is called in -gnatc mode???
if Ekind (Entity (N)) /= E_In_Parameter
- and then In_Assignment_Context (N)
+ and then Known_To_Be_Assigned (N)
then
Note_Possible_Modification (N, Sure => True);
end if;
Rneg : Boolean;
-- Set if corresponding operand can be negative
- pragma Unreferenced (Hi);
-
begin
Binary_Op_Validity_Checks (N);
Lit : Entity_Id;
Nlit : Nat;
S_Id : Entity_Id;
- S_N : Nat;
+ S_N : Nat := 0;
Str : String_Id;
package SPHG renames System.Perfect_Hash_Generators;
if Is_Checked_Ghost_Entity (Id)
and then Policy = Name_Ignore
- and then May_Be_Lvalue (Ref)
+ and then Known_To_Be_Assigned (Ref)
then
Error_Msg_Sloc := Sloc (Ref);
The left hand side of an assignment does not count as a reference for the
purpose of this pragma. Thus it is fine to assign to an entity for which
-pragma Unreferenced is given.
+pragma Unreferenced is given. However, use of an entity as an actual for
+an out parameter does count as a reference unless warnings for unread output
+parameters are enabled via @code{-gnatw.o}.
Note that if a warning is desired for all calls to a given subprogram,
regardless of whether they occur in the same unit as the subprogram
-- Get the enclosing entity through renamings, which may come from
-- source or from the translation of generic instantiations.
- function Is_On_LHS (Node : Node_Id) return Boolean;
- -- Used to check if a node is on the left hand side of an assignment.
- -- The following cases are handled:
- --
- -- Variable Node is a direct descendant of left hand side of an
- -- assignment statement.
- --
- -- Prefix Of an indexed or selected component that is present in
- -- a subtree rooted by an assignment statement. There is
- -- no restriction of nesting of components, thus cases
- -- such as A.B (C).D are handled properly. However a prefix
- -- of a dereference (either implicit or explicit) is never
- -- considered as on a LHS.
- --
- -- Out param Same as above cases, but OUT parameter
-
function OK_To_Set_Referenced return Boolean;
-- Returns True if the Referenced flag can be set. There are a few
-- exceptions where we do not want to set this flag, see body for
end case;
end Get_Through_Renamings;
- ---------------
- -- Is_On_LHS --
- ---------------
-
- -- ??? There are several routines here and there that perform a similar
- -- (but subtly different) computation, which should be factored:
-
- -- Sem_Util.Is_LHS
- -- Sem_Util.May_Be_Lvalue
- -- Sem_Util.Known_To_Be_Assigned
- -- Exp_Ch2.Expand_Entry_Parameter.In_Assignment_Context
- -- Exp_Smem.Is_Out_Actual
-
- function Is_On_LHS (Node : Node_Id) return Boolean is
- N : Node_Id;
- P : Node_Id;
- K : Node_Kind;
-
- begin
- -- Only identifiers are considered, is this necessary???
-
- if Nkind (Node) /= N_Identifier then
- return False;
- end if;
-
- -- Immediate return if appeared as OUT parameter
-
- if Kind = E_Out_Parameter then
- return True;
- end if;
-
- -- Search for assignment statement subtree root
-
- N := Node;
- loop
- P := Parent (N);
- K := Nkind (P);
-
- if K = N_Assignment_Statement then
- return Name (P) = N;
-
- -- Check whether the parent is a component and the current node is
- -- its prefix, but return False if the current node has an access
- -- type, as in that case the selected or indexed component is an
- -- implicit dereference, and the LHS is the designated object, not
- -- the access object.
-
- -- ??? case of a slice assignment?
-
- elsif (K = N_Selected_Component or else K = N_Indexed_Component)
- and then Prefix (P) = N
- then
- -- Check for access type. First a special test, In some cases
- -- this is called too early (see comments in Find_Direct_Name),
- -- at a point where the tree is not fully typed yet. In that
- -- case we may lack an Etype for N, and we can't check the
- -- Etype. For now, we always return False in such a case,
- -- but this is clearly not right in all cases ???
-
- if No (Etype (N)) then
- return False;
-
- elsif Is_Access_Type (Etype (N)) then
- return False;
-
- -- Access type case dealt with, keep going
-
- else
- N := P;
- end if;
-
- -- All other cases, definitely not on left side
-
- else
- return False;
- end if;
- end loop;
- end Is_On_LHS;
-
---------------------------
-- OK_To_Set_Referenced --
---------------------------
if Set_Ref then
- -- Assignable object appearing on left side of assignment or as
- -- an out parameter.
+ -- When E itself is an IN OUT parameter mark it referenced
if Is_Assignable (E)
- and then Is_On_LHS (N)
- and then Ekind (E) /= E_In_Out_Parameter
+ and then Ekind (E) = E_In_Out_Parameter
+ and then Known_To_Be_Assigned (N)
then
- -- For objects that are renamings, just set as simply referenced
- -- we do not try to do assignment type tracking in this case.
-
- if Present (Renamed_Object (E)) then
- Set_Referenced (E);
-
- -- Out parameter case
-
- elsif Kind = E_Out_Parameter then
-
- -- If warning mode for all out parameters is set, or this is
- -- the only warning parameter, then we want to mark this for
- -- later warning logic by setting Referenced_As_Out_Parameter
+ Set_Referenced (E);
- if Warn_On_Modified_As_Out_Parameter (Formal) then
- Set_Referenced_As_Out_Parameter (E, True);
- Set_Referenced_As_LHS (E, False);
+ -- For the case where the entity is on the left hand side of an
+ -- assignment statment, we do nothing here.
- -- For OUT parameter not covered by the above cases, we simply
- -- regard it as a normal reference (in this case we do not
- -- want any of the warning machinery for out parameters).
+ -- The processing for Analyze_Assignment_Statement will set the
+ -- Referenced_As_LHS flag.
- else
- Set_Referenced (E);
- end if;
+ elsif Is_Assignable (E)
+ and then Known_To_Be_Assigned (N, Only_LHS => True)
+ then
+ null;
- -- For the left hand of an assignment case, we do nothing here.
- -- The processing for Analyze_Assignment will set the
- -- Referenced_As_LHS flag.
+ -- For objects that are renamings, just set as simply referenced.
+ -- We do not try to do assignment type tracking in this case.
- else
- null;
- end if;
+ elsif Is_Assignable (E)
+ and then Present (Renamed_Object (E))
+ then
+ Set_Referenced (E);
-- Check for a reference in a pragma that should not count as a
-- making the variable referenced for warning purposes.
then
null;
- -- All other cases
+ -- Out parameter case
- else
- -- Special processing for IN OUT parameters, where we have an
- -- implicit assignment to a simple variable.
+ elsif Kind = E_Out_Parameter
+ and then Is_Assignable (E)
+ then
+ -- If warning mode for all out parameters is set, or this is
+ -- the only warning parameter, then we want to mark this for
+ -- later warning logic by setting Referenced_As_Out_Parameter
- if Kind = E_In_Out_Parameter
- and then Is_Assignable (E)
- then
- -- For sure this counts as a normal read reference
+ if Warn_On_Modified_As_Out_Parameter (Formal) then
+ Set_Referenced_As_Out_Parameter (E, True);
+ Set_Referenced_As_LHS (E, False);
+
+ -- For OUT parameter not covered by the above cases, we simply
+ -- regard it as a non-reference.
+ else
+ Set_Referenced_As_Out_Parameter (E);
Set_Referenced (E);
- Set_Last_Assignment (E, Empty);
+ end if;
- -- We count it as being referenced as an out parameter if the
- -- option is set to warn on all out parameters, except that we
- -- have a special exclusion for an intrinsic subprogram, which
- -- is most likely an instantiation of Unchecked_Deallocation
- -- which we do not want to consider as an assignment since it
- -- generates false positives. We also exclude the case of an
- -- IN OUT parameter if the name of the procedure is Free,
- -- since we suspect similar semantics.
-
- if Warn_On_All_Unread_Out_Parameters
- and then Is_Entity_Name (Name (Call))
- and then not Is_Intrinsic_Subprogram (Entity (Name (Call)))
- and then Chars (Name (Call)) /= Name_Free
- then
- Set_Referenced_As_Out_Parameter (E, True);
- Set_Referenced_As_LHS (E, False);
- end if;
+ -- Special processing for IN OUT parameters, where we have an
+ -- implicit assignment to a simple variable.
- -- Don't count a recursive reference within a subprogram as a
- -- reference (that allows detection of a recursive subprogram
- -- whose only references are recursive calls as unreferenced).
+ elsif Kind = E_In_Out_Parameter
+ and then Is_Assignable (E)
+ then
+ -- For sure this counts as a normal read reference
- elsif Is_Subprogram (E)
- and then E = Nearest_Dynamic_Scope (Current_Scope)
+ Set_Referenced (E);
+ Set_Last_Assignment (E, Empty);
+
+ -- We count it as being referenced as an out parameter if the
+ -- option is set to warn on all out parameters, except that we
+ -- have a special exclusion for an intrinsic subprogram, which
+ -- is most likely an instantiation of Unchecked_Deallocation
+ -- which we do not want to consider as an assignment since it
+ -- generates false positives. We also exclude the case of an
+ -- IN OUT parameter if the name of the procedure is Free,
+ -- since we suspect similar semantics.
+
+ if Warn_On_All_Unread_Out_Parameters
+ and then Is_Entity_Name (Name (Call))
+ and then not Is_Intrinsic_Subprogram (Entity (Name (Call)))
+ and then Chars (Name (Call)) /= Name_Free
then
- null;
+ Set_Referenced_As_Out_Parameter (E, True);
+ Set_Referenced_As_LHS (E, False);
+ end if;
- -- Any other occurrence counts as referencing the entity
+ -- Don't count a recursive reference within a subprogram as a
+ -- reference (that allows detection of a recursive subprogram
+ -- whose only references are recursive calls as unreferenced).
- elsif OK_To_Set_Referenced then
- Set_Referenced (E);
+ elsif Is_Subprogram (E)
+ and then E = Nearest_Dynamic_Scope (Current_Scope)
+ then
+ null;
- -- If variable, this is an OK reference after an assignment
- -- so we can clear the Last_Assignment indication.
+ -- Any other occurrence counts as referencing the entity
- if Is_Assignable (E) then
- Set_Last_Assignment (E, Empty);
- end if;
+ elsif OK_To_Set_Referenced then
+ Set_Referenced (E);
+
+ -- If variable, this is an OK reference after an assignment
+ -- so we can clear the Last_Assignment indication.
+
+ if Is_Assignable (E) then
+ Set_Last_Assignment (E, Empty);
end if;
end if;
and then In_Same_Extended_Unit (E, N)
then
-- A reference as a named parameter in a call does not count as a
- -- violation of pragma Unreferenced for this purpose...
+ -- violation of pragma Unreferenced for this purpose.
if Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Parameter_Association
then
null;
- -- ... Neither does a reference to a variable on the left side of
- -- an assignment.
-
- elsif Is_On_LHS (N) then
+ -- Neither does a reference to a variable on the left side of
+ -- an assignment or use of an out parameter with warnings for
+ -- unread out parameters specified (via -gnatw.o).
+
+ -- The reason for treating unread out parameters in a special
+ -- way is so that when pragma Unreferenced is specified on such
+ -- an out parameter we do not want to issue a warning about the
+ -- pragma being unnecessary - because the purpose of the flag
+ -- is to warn about them not being read (e.g. unreferenced)
+ -- after use.
+
+ elsif (Known_To_Be_Assigned (N, Only_LHS => True)
+ or else (Present (Formal)
+ and then Ekind (Formal) = E_Out_Parameter
+ and then Warn_On_All_Unread_Out_Parameters))
+ and then not (Ekind (E) = E_In_Out_Parameter
+ and then Known_To_Be_Assigned (N))
+ then
null;
-- Do not consider F'Result as a violation of pragma Unreferenced
D : Deferred_Reference_Entry renames Deferred_References.Table (J);
begin
- case Is_LHS (D.N) is
- when Yes =>
+ case Known_To_Be_Assigned (D.N) is
+ when True =>
Generate_Reference (D.E, D.N, 'm');
- when No =>
+ when False =>
Generate_Reference (D.E, D.N, 'r');
- -- Not clear if Unknown can occur at this stage, but if it
- -- does we will treat it as a normal reference.
-
- when Unknown =>
- Generate_Reference (D.E, D.N, 'r');
end case;
end;
end loop;
Dequeued : Delay_Block_Access;
Dequeued_Task : Task_Id;
- pragma Unreferenced (Timedout, Yielded);
-
begin
pragma Assert (Timer_Server_ID = STPO.Self);
Uninterpreted_Data : System.Address)
is
Rendezvous_Successful : Boolean;
- pragma Unreferenced (Rendezvous_Successful);
begin
-- If pragma Detect_Blocking is active then Program_Error must be
Entry_Call : Entry_Call_Link;
Yielded : Boolean;
- pragma Unreferenced (Yielded);
begin
-- If pragma Detect_Blocking is active then Program_Error must be
Ceiling_Violation : Boolean;
Yielded : Boolean;
- pragma Unreferenced (Yielded);
begin
if Self_Id.ATC_Nesting_Level = ATC_Level'Last then
Y : Year_Number;
M : Month_Number;
S : Day_Duration;
- pragma Unreferenced (Y, M, S);
begin
Split (Date, Y, M, D, S);
return D;
M : Month_Number;
D : Day_Number;
S : Day_Duration;
- pragma Unreferenced (Y, D, S);
begin
Split (Date, Y, M, D, S);
return M;
M : Month_Number;
D : Day_Number;
S : Day_Duration;
- pragma Unreferenced (Y, M, D);
begin
Split (Date, Y, M, D, S);
return S;
Ss : Duration;
Le : Boolean;
- pragma Unreferenced (H, M, Se, Ss, Le);
-
begin
-- Even though the input time zone is UTC (0), the flag Use_TZ will
-- ensure that Split picks up the local time zone.
M : Month_Number;
D : Day_Number;
S : Day_Duration;
- pragma Unreferenced (M, D, S);
begin
Split (Date, Y, M, D, S);
return Y;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, Mo, H, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
return D;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, Mo, D, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
return H;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, Mo, D, H);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
return Mi;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, D, H, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
return Mo;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, Mo, D, H, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
return Se;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Y, Mo, D, H, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le);
return Ss;
Ss : Second_Duration;
Le : Boolean;
- pragma Unreferenced (Mo, D, H, Mi);
-
begin
Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone);
return Y;
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert_Child (Container, Parent, Before, New_Item, Position, Count);
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Dst_Node : out Count_Type)
is
Success : Boolean;
- pragma Unreferenced (Success);
procedure Set_Element (Node : in out Node_Type);
pragma Inline (Set_Element);
function To_Set (New_Item : Element_Type) return Set is
Node : Count_Type;
Inserted : Boolean;
+
begin
return S : Set (1) do
Insert_Sans_Hint (S, New_Item, Node, Inserted);
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Dst_Node : out Count_Type)
is
Success : Boolean;
- pragma Unreferenced (Success);
procedure Set_Element (Node : in out Node_Type);
function To_Set (New_Item : Element_Type) return Set is
Node : Count_Type;
Inserted : Boolean;
+
begin
return S : Set (Capacity => 1) do
Insert_Sans_Hint (S.Content, New_Item, Node, Inserted);
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
HT : Hash_Table_Type;
Node : Node_Access;
Inserted : Boolean;
- pragma Unreferenced (Node, Inserted);
begin
Insert (HT, New_Item, Node, Inserted);
return Set'(Controlled with HT);
Tgt_Node : Node_Access;
Success : Boolean;
- pragma Unreferenced (Tgt_Node, Success);
-- Start of processing for Process
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert_Child (Container, Parent, Before, New_Item, Position, Count);
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
procedure Insert (Container : in out Set; New_Item : Element_Type) is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, New_Item, Position);
end Insert;
function To_Set (New_Item : Element_Type) return Set is
Tree : Tree_Type;
Node : Node_Access;
- pragma Unreferenced (Node);
begin
Insert_Sans_Hint (Tree, New_Item, Node);
return Set'(Controlled with Tree);
procedure Insert (Container : in out Set; New_Item : Element_Type) is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Dst_Node : out Node_Access)
is
Success : Boolean;
- pragma Unreferenced (Success);
function New_Node return Node_Access;
Tree : Tree_Type;
Node : Node_Access;
Inserted : Boolean;
- pragma Unreferenced (Node, Inserted);
begin
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
return Set'(Controlled with Tree);
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Node : Node_Access;
Inserted : Boolean;
- pragma Unreferenced (Node, Inserted);
begin
Insert (HT, New_Item, Node, Inserted);
Tgt_Node : Node_Access;
Success : Boolean;
- pragma Unreferenced (Tgt_Node, Success);
-- Start of processing for Process
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert_Child (Container, Parent, Before, New_Item, Position, Count);
declare
SA : Elements_Array renames Container.Elements.EA; -- source
DA : Elements_Array renames Dst.EA; -- destination
+ pragma Unreferenced (DA);
begin
DA (Index_Type'First .. Before - 1) :=
declare
SA : Elements_Array renames Container.Elements.EA; -- source
DA : Elements_Array renames Dst.EA; -- destination
+ pragma Unreferenced (DA);
begin
DA (Index_Type'First .. Before - 1) :=
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
procedure Insert (Container : in out Set; New_Item : Element_Type) is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, New_Item, Position);
end Insert;
function To_Set (New_Item : Element_Type) return Set is
Tree : Tree_Type;
Node : Node_Access;
- pragma Unreferenced (Node);
begin
Insert_Sans_Hint (Tree, New_Item, Node);
return Set'(Controlled with Tree);
New_Item : Element_Type)
is
Position : Cursor;
- pragma Unreferenced (Position);
-
Inserted : Boolean;
begin
Dst_Node : out Node_Access)
is
Success : Boolean;
- pragma Unreferenced (Success);
function New_Node return Node_Access;
pragma Inline (New_Node);
Tree : Tree_Type;
Node : Node_Access;
Inserted : Boolean;
- pragma Unreferenced (Node, Inserted);
begin
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
return Set'(Controlled with Tree);
Count : Count_Type := 1)
is
Position : Cursor;
- pragma Unreferenced (Position);
begin
Insert (Container, Before, New_Item, Position, Count);
end Insert;
Ptr : in out Integer)
is
Junk : Boolean;
- pragma Unreferenced (Junk);
begin
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
Ptr : in out Integer)
is
Junk : Boolean;
- pragma Unreferenced (Junk);
begin
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
Ptr : in out Integer)
is
Junk : Boolean;
- pragma Unreferenced (Junk);
begin
Load_Extended_Digits (File, Buf, Ptr, Junk);
end Load_Extended_Digits;
Month : Month_Number;
Day : Day_Number;
Day_Secs : Day_Duration;
- pragma Unreferenced (Day_Secs);
begin
Split (Date, Year, Month, Day, Day_Secs);
return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
Month : Month_Number;
Day : Day_Number;
Day_Secs : Day_Duration;
- pragma Unreferenced (Day_Secs);
begin
Split (Date, Year, Month, Day, Day_Secs);
return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
- pragma Unreferenced (Year, Month, Day, Minute, Second, Sub_Second);
begin
Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
return Hour;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
- pragma Unreferenced (Year, Month, Day, Hour, Second, Sub_Second);
begin
Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
return Minute;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
- pragma Unreferenced (Year, Month, Day, Hour, Minute, Sub_Second);
begin
Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
return Second;
Ds : Day_Duration;
Le : Boolean;
- pragma Unreferenced (Ds, Le);
-
begin
-- Even though the input time zone is UTC (0), the flag Use_TZ will
-- ensure that Split picks up the local time zone. ???But Use_TZ is
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
- pragma Unreferenced (Year, Month, Day, Hour, Minute, Second);
begin
Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
return Sub_Second;
function Week_In_Year (Date : Time) return Week_In_Year_Number is
Year : Year_Number;
Week : Week_In_Year_Number;
- pragma Unreferenced (Year);
begin
Year_Week_In_Year (Date, Year, Week);
return Week;
Shift : Week_In_Year_Number;
Start_Week : Week_In_Year_Number;
- pragma Unreferenced (Hour, Minute, Second, Sub_Second);
-
function Is_Leap (Year : Year_Number) return Boolean;
-- Return True if Year denotes a leap year. Leap centennial years are
-- properly handled.
Add_Before : Boolean := False)
is
Success : Boolean;
- pragma Unreferenced (Success);
begin
Add_Switch (Cmd, Switch, Parameter, Separator,
Section, Add_Before, Success);
Section : String := "")
is
Success : Boolean;
- pragma Unreferenced (Success);
begin
Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
end Remove_Switch;
procedure Close (Descriptor : in out Process_Descriptor) is
Status : Integer;
- pragma Unreferenced (Status);
begin
Close (Descriptor, Status);
end Close;
declare
Result : Expect_Match;
- pragma Unreferenced (Result);
begin
-- This loop runs until the call to Expect raises Process_Died
Pipe3 : not null access Pipe_Type)
is
Status : Boolean;
- pragma Unreferenced (Status);
+ pragma Warnings (Off, "modified by call, but value overwritten");
begin
-- Create the pipes
function Euclid (P, Q : Int) return Int is
X, Y, GCD : Int;
- pragma Unreferenced (Y, GCD);
begin
Euclid (P, Q, X, Y, GCD);
return X;
L : Natural;
Start : Natural;
Stop : Natural;
- pragma Unreferenced (Stop);
begin
Get_String (Subject, S, L);
Pat : Pattern) return Boolean
is
Start, Stop : Natural;
- pragma Unreferenced (Stop);
subtype String1 is String (1 .. Subject'Length);
Start : Natural;
Stop : Natural;
- pragma Unreferenced (Start, Stop);
begin
Get_String (Subject, S, L);
Pat : Pattern)
is
Start, Stop : Natural;
- pragma Unreferenced (Start, Stop);
subtype String1 is String (1 .. Subject'Length);
Start : Natural;
Stop : Natural;
- pragma Unreferenced (Start, Stop);
begin
Get_String (Subject, S, L);
Pat : PString)
is
Start, Stop : Natural;
- pragma Unreferenced (Start, Stop);
subtype String1 is String (1 .. Subject'Length);
function Compose (Fraction : T; Exponent : UI) return T is
Arg_Frac : T;
Arg_Exp : UI;
- pragma Unreferenced (Arg_Exp);
begin
Decompose (Fraction, Arg_Frac, Arg_Exp);
return Scaling (Arg_Frac, Exponent);
function Exponent (X : T) return UI is
X_Frac : T;
X_Exp : UI;
- pragma Unreferenced (X_Frac);
begin
Decompose (X, X_Frac, X_Exp);
return X_Exp;
function Fraction (X : T) return T is
X_Frac : T;
X_Exp : UI;
- pragma Unreferenced (X_Exp);
begin
Decompose (X, X_Frac, X_Exp);
return X_Frac;
P_Even : Boolean;
Arg_Frac : T;
- pragma Unreferenced (Arg_Frac);
begin
if Y = 0.0 then
Default : Boolean) return Boolean
is
V1, V2 : Natural;
- pragma Unreferenced (V2);
begin
Form_Parameter (Form, Keyword, V1, V2);
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Unreferenced (Y, Mo, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
D : Day_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Unreferenced (Y, Mo, D, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
D : Day_Type;
H : Hour_Type;
S : Second_Type;
- pragma Unreferenced (Y, Mo, D, H, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Unreferenced (Y, D, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
D : Day_Type;
H : Hour_Type;
Mn : Minute_Type;
- pragma Unreferenced (Y, Mo, D, H, Mn);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Unreferenced (Mo, D, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
Result : Pointer;
Expr_Flags : Expression_Flags;
- pragma Unreferenced (Expr_Flags);
-- Start of processing for Compile
is
PM : Pattern_Matcher (Size);
Finalize_Size : Program_Size;
- pragma Unreferenced (Finalize_Size);
begin
if Size = 0 then
Match (Compile (Expression), Data, Matches, Data_First, Data_Last);
is
PM : Pattern_Matcher (Size);
Final_Size : Program_Size;
- pragma Unreferenced (Final_Size);
begin
if Size = 0 then
return Match (Compile (Expression), Data, Data_First, Data_Last);
Matches : Match_Array (0 .. 0);
PM : Pattern_Matcher (Size);
Final_Size : Program_Size;
- pragma Unreferenced (Final_Size);
begin
if Size = 0 then
Match (Compile (Expression), Data, Matches, Data_First, Data_Last);
Base : Unsigned;
ScaleB : Integer;
Extra : Unsigned;
- pragma Unreferenced (Extra);
Minus : Boolean;
Val : Uns;
Base : Unsigned;
ScaleB : Integer;
Extra : Unsigned;
- pragma Unreferenced (Extra);
Minus : Boolean;
Val : Uns;
-- Local copy of string pointer
Start : Positive;
- pragma Unreferenced (Start);
Value : Uns;
-- Mantissa as an Integer
Error_Msg_N -- CODEFIX
("redundant with clause in body?r?", Clause);
end if;
-
- Used_In_Body := False;
- Used_In_Spec := False;
- Used_Type_Or_Elab := False;
- Withed_In_Spec := False;
end;
-- Standalone package spec or body check
Func_Name : constant Node_Id := Expression (ASN);
Overloaded : Boolean := Is_Overloaded (Func_Name);
- I : Interp_Index;
+ I : Interp_Index := 0;
It : Interp;
Param_Type : Entity_Id;
Match_Found : Boolean := False;
Indic : constant Node_Id := Subtype_Indication (Def);
Corr_Record : constant Entity_Id := Make_Temporary (Loc, 'C');
- Corr_Decl : Node_Id;
+ Corr_Decl : Node_Id := Empty;
Corr_Decl_Needed : Boolean;
-- If the derived type has fewer discriminants than its parent, the
-- corresponding record is also a derived type, in order to account for
-- Else see if we have a left hand side
else
- case Is_LHS (N) is
- when Yes =>
+ case Known_To_Be_Assigned (N, Only_LHS => True) is
+ when True =>
Generate_Reference (E, N, 'm');
- when No =>
+ when False =>
Generate_Reference (E, N, 'r');
- -- If we don't know now, generate reference later
-
- when Unknown =>
- Defer_Reference ((E, N));
end case;
end if;
end if;
if Needs_Variable_Reference_Marker (N => N, Calls_OK => False) then
declare
- Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
+ Is_Assignment_LHS : constant Boolean := Known_To_Be_Assigned (N);
begin
Build_Variable_Reference_Marker
else
Set_Entity_Or_Discriminal (N, Id);
- case Is_LHS (N) is
- when Yes =>
+ case Known_To_Be_Assigned (N, Only_LHS => True) is
+ when True =>
Generate_Reference (Id, N, 'm');
- when No =>
+ when False =>
Generate_Reference (Id, N, 'r');
- when Unknown =>
- Defer_Reference ((Id, N));
end case;
end if;
Calls_OK => False)
then
declare
- Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
+ Is_Assignment_LHS : constant Boolean := Known_To_Be_Assigned (N);
begin
Build_Variable_Reference_Marker
-- Fold will perform the other relevant tests.
if Nkind (Parent (N)) /= N_Attribute_Reference
- and then Is_LHS (N) = No
+ and then not Known_To_Be_Assigned (N)
and then not Is_Actual_Out_Or_In_Out_Parameter (N)
then
-- Simplify a selected_component on an aggregate by extracting
-- resolution was complete to do this, since otherwise we can't tell if
-- we are an lvalue or not.
- if May_Be_Lvalue (N) then
+ if Known_To_Be_Assigned (N) then
Generate_Reference (Entity (S), S, 'm');
else
Generate_Reference (Entity (S), S, 'r');
if Is_Entity_Name (P)
and then Has_Deferred_Reference (Entity (P))
then
- if May_Be_Lvalue (N) then
+ if Known_To_Be_Assigned (N) then
Generate_Reference (Entity (P), P, 'm');
else
Generate_Reference (Entity (P), P, 'r');
-- Local variables
- Owner : Node_Id;
+ Owner : Node_Id := Empty;
-- Start of processing for End_Keyword_Location
function Expression_Of_Expression_Function
(Subp : Entity_Id) return Node_Id
is
- Expr_Func : Node_Id;
+ Expr_Func : Node_Id := Empty;
begin
pragma Assert (Is_Expression_Function_Or_Completion (Subp));
then
Call_Nam := Name (Call);
+ -- A call to an entry family may appear as an indexed component
+
+ if Nkind (Call_Nam) = N_Indexed_Component then
+ Call_Nam := Prefix (Call_Nam);
+ end if;
+
-- A call to a protected or task entry appears as a selected
-- component rather than an expanded name.
if Is_Entity_Name (Call_Nam)
and then Present (Entity (Call_Nam))
- and then Is_Overloadable (Entity (Call_Nam))
+ and then (Is_Generic_Subprogram (Entity (Call_Nam))
+ or else Is_Overloadable (Entity (Call_Nam))
+ or else Ekind (Entity (Call_Nam)) in E_Entry_Family
+ | E_Subprogram_Body
+ | E_Subprogram_Type)
and then not Is_Overloaded (Call_Nam)
then
-- If node is name in call it is not an actual
return Is_Array_Type (Container_Typ);
end Is_Iterator_Over_Array;
- ------------
- -- Is_LHS --
- ------------
+ --------------------------
+ -- Known_To_Be_Assigned --
+ --------------------------
- -- We seem to have a lot of overlapping functions that do similar things
- -- (testing for left hand sides or lvalues???).
+ function Known_To_Be_Assigned
+ (N : Node_Id;
+ Only_LHS : Boolean := False) return Boolean
+ is
+ function Known_Assn (N : Node_Id) return Boolean is
+ (Known_To_Be_Assigned (N, Only_LHS));
+ -- Local function to simplify the passing of parameters for recursive
+ -- calls.
- function Is_LHS (N : Node_Id) return Is_LHS_Result is
- P : constant Node_Id := Parent (N);
+ P : constant Node_Id := Parent (N);
+ Form : Entity_Id := Empty;
+ Call : Node_Id := Empty;
+
+ -- Start of processing for Known_To_Be_Assigned
begin
- -- Return True if we are the left hand side of an assignment statement
+ -- Check for out parameters
- if Nkind (P) = N_Assignment_Statement then
- if Name (P) = N then
- return Yes;
- else
- return No;
- end if;
+ Find_Actual (N, Form, Call);
- -- Case of prefix of indexed or selected component or slice
+ if Present (Form) then
+ return Ekind (Form) /= E_In_Parameter and then not Only_LHS;
+ end if;
- elsif Nkind (P) in N_Indexed_Component | N_Selected_Component | N_Slice
- and then N = Prefix (P)
- then
- -- Here we have the case where the parent P is N.Q or N(Q .. R).
- -- If P is an LHS, then N is also effectively an LHS, but there
- -- is an important exception. If N is of an access type, then
- -- what we really have is N.all.Q (or N.all(Q .. R)). In either
- -- case this makes N.all a left hand side but not N itself.
+ -- Otherwise look at the parent
- -- If we don't know the type yet, this is the case where we return
- -- Unknown, since the answer depends on the type which is unknown.
+ case Nkind (P) is
- if No (Etype (N)) then
- return Unknown;
+ -- Test left side of assignment
- -- We have an Etype set, so we can check it
+ when N_Assignment_Statement =>
+ return N = Name (P);
- elsif Is_Access_Type (Etype (N)) then
- return No;
+ -- Test prefix of component or attribute. Note that the prefix of an
+ -- explicit or implicit dereference cannot be an l-value. In the case
+ -- of a 'Read attribute, the reference can be an actual in the
+ -- argument list of the attribute.
- -- OK, not access type case, so just test whole expression
+ when N_Attribute_Reference =>
+ return
+ not Only_LHS and then
+ ((N = Prefix (P)
+ and then Name_Implies_Lvalue_Prefix (Attribute_Name (P)))
+ or else
+ Attribute_Name (P) = Name_Read);
- else
- return Is_LHS (P);
- end if;
+ -- 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 =>
+ if N = Prefix (P) then
+ return Known_Assn (P);
+ else
+ return False;
+ end if;
- -- All other cases are not left hand sides
+ -- 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.
- else
- return No;
- end if;
- end Is_LHS;
+ when N_Selected_Component =>
+ if N = Prefix (P)
+ and then Present (Etype (N))
+ and then Is_Access_Type (Etype (N))
+ then
+ return False;
+ else
+ return Known_Assn (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
+ -- have an implicit dereference.
+
+ when N_Indexed_Component | N_Slice =>
+ if N /= Prefix (P)
+ or else (Present (Etype (N)) and then Is_Access_Type (Etype (N)))
+ then
+ return False;
+ else
+ return Known_Assn (P);
+ end if;
+
+ -- Prefix of a reference is an lvalue if the reference is an lvalue
+
+ when N_Reference =>
+ return Known_Assn (P);
+
+ -- Prefix of explicit dereference is never an lvalue
+
+ when N_Explicit_Dereference =>
+ return False;
+
+ -- Test for appearing in a conversion that itself appears in an
+ -- lvalue context, since this should be an lvalue.
+
+ when N_Type_Conversion =>
+ return Known_Assn (P);
+
+ -- Test for appearance in object renaming declaration
+
+ when N_Object_Renaming_Declaration =>
+ return not Only_LHS;
+
+ -- All other references are definitely not lvalues
+
+ when others =>
+ return False;
+ end case;
+ end Known_To_Be_Assigned;
-----------------------------
-- Is_Library_Level_Entity --
return False;
end Known_Null;
- --------------------------
- -- Known_To_Be_Assigned --
- --------------------------
-
- function Known_To_Be_Assigned (N : Node_Id) return Boolean is
- P : constant Node_Id := Parent (N);
-
- begin
- case Nkind (P) is
-
- -- Test left side of assignment
-
- when N_Assignment_Statement =>
- return N = Name (P);
-
- -- Function call arguments are never lvalues
-
- when N_Function_Call =>
- return False;
-
- -- Positional parameter for procedure or accept call
-
- when N_Accept_Statement
- | N_Procedure_Call_Statement
- =>
- declare
- Proc : Entity_Id;
- Form : Entity_Id;
- Act : Node_Id;
-
- begin
- Proc := Get_Subprogram_Entity (P);
-
- if No (Proc) then
- return False;
- end if;
-
- -- If we are not a list member, something is strange, so
- -- be conservative and return False.
-
- if not Is_List_Member (N) then
- return False;
- end if;
-
- -- We are going to find the right formal by stepping forward
- -- through the formals, as we step backwards in the actuals.
-
- Form := First_Formal (Proc);
- Act := N;
- loop
- -- If no formal, something is weird, so be conservative
- -- and return False.
-
- if No (Form) then
- return False;
- end if;
-
- Prev (Act);
- exit when No (Act);
- Next_Formal (Form);
- end loop;
-
- return Ekind (Form) /= E_In_Parameter;
- end;
-
- -- Named parameter for procedure or accept call
-
- when N_Parameter_Association =>
- declare
- Proc : Entity_Id;
- Form : Entity_Id;
-
- begin
- Proc := Get_Subprogram_Entity (Parent (P));
-
- if No (Proc) then
- return False;
- end if;
-
- -- Loop through formals to find the one that matches
-
- Form := First_Formal (Proc);
- loop
- -- If no matching formal, that's peculiar, some kind of
- -- previous error, so return False to be conservative.
- -- Actually this also happens in legal code in the case
- -- where P is a parameter association for an Extra_Formal???
-
- if No (Form) then
- return False;
- end if;
-
- -- Else test for match
-
- if Chars (Form) = Chars (Selector_Name (P)) then
- return Ekind (Form) /= E_In_Parameter;
- end if;
-
- Next_Formal (Form);
- end loop;
- end;
-
- -- Test for appearing in a conversion that itself appears
- -- in an lvalue context, since this should be an lvalue.
-
- when N_Type_Conversion =>
- return Known_To_Be_Assigned (P);
-
- -- All other references are definitely not known to be modifications
-
- when others =>
- return False;
- end case;
- end Known_To_Be_Assigned;
-
---------------------------
-- Last_Source_Statement --
---------------------------
return True;
end Matching_Static_Array_Bounds;
- -------------------
- -- May_Be_Lvalue --
- -------------------
-
- function May_Be_Lvalue (N : Node_Id) return Boolean is
- P : constant Node_Id := Parent (N);
-
- begin
- case Nkind (P) is
-
- -- Test left side of assignment
-
- when N_Assignment_Statement =>
- return N = Name (P);
-
- -- Test prefix of component or attribute. Note that the prefix of an
- -- explicit or implicit dereference cannot be an l-value. In the case
- -- of a 'Read attribute, the reference can be an actual in the
- -- argument list of the attribute.
-
- when N_Attribute_Reference =>
- return (N = Prefix (P)
- and then Name_Implies_Lvalue_Prefix (Attribute_Name (P)))
- or else
- Attribute_Name (P) = Name_Read;
-
- -- 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 =>
- if N = Prefix (P) then
- return May_Be_Lvalue (P);
- else
- return False;
- end if;
-
- -- 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)
- and then Present (Etype (N))
- and then Is_Access_Type (Etype (N))
- then
- return False;
- else
- return May_Be_Lvalue (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
- -- have an implicit dereference.
-
- when N_Indexed_Component
- | N_Slice
- =>
- if N /= Prefix (P)
- or else (Present (Etype (N)) and then Is_Access_Type (Etype (N)))
- then
- return False;
- else
- return May_Be_Lvalue (P);
- end if;
-
- -- 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
-
- when N_Explicit_Dereference =>
- return False;
-
- -- Positional parameter for subprogram, entry, or accept call.
- -- In older versions of Ada function call arguments are never
- -- lvalues. In Ada 2012 functions can have in-out parameters.
-
- when N_Accept_Statement
- | N_Entry_Call_Statement
- | N_Subprogram_Call
- =>
- if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then
- return False;
- end if;
-
- -- The following mechanism is clumsy and fragile. A single flag
- -- set in Resolve_Actuals would be preferable ???
-
- declare
- Proc : Entity_Id;
- Form : Entity_Id;
- Act : Node_Id;
-
- begin
- Proc := Get_Subprogram_Entity (P);
-
- if No (Proc) then
- return True;
- end if;
-
- -- If we are not a list member, something is strange, so be
- -- conservative and return True.
-
- if not Is_List_Member (N) then
- return True;
- end if;
-
- -- We are going to find the right formal by stepping forward
- -- through the formals, as we step backwards in the actuals.
-
- Form := First_Formal (Proc);
- Act := N;
- loop
- -- If no formal, something is weird, so be conservative and
- -- return True.
-
- if No (Form) then
- return True;
- end if;
-
- Prev (Act);
- exit when No (Act);
- Next_Formal (Form);
- end loop;
-
- return Ekind (Form) /= E_In_Parameter;
- end;
-
- -- Named parameter for procedure or accept call
-
- when N_Parameter_Association =>
- declare
- Proc : Entity_Id;
- Form : Entity_Id;
-
- begin
- Proc := Get_Subprogram_Entity (Parent (P));
-
- if No (Proc) then
- return True;
- end if;
-
- -- Loop through formals to find the one that matches
-
- Form := First_Formal (Proc);
- loop
- -- If no matching formal, that's peculiar, some kind of
- -- previous error, so return True to be conservative.
- -- Actually happens with legal code for an unresolved call
- -- where we may get the wrong homonym???
-
- if No (Form) then
- return True;
- end if;
-
- -- Else test for match
-
- if Chars (Form) = Chars (Selector_Name (P)) then
- return Ekind (Form) /= E_In_Parameter;
- end if;
-
- Next_Formal (Form);
- end loop;
- end;
-
- -- Test for appearing in a conversion that itself appears in an
- -- lvalue context, since this should be an lvalue.
-
- when N_Type_Conversion =>
- return May_Be_Lvalue (P);
-
- -- Test for appearance in object renaming declaration
-
- when N_Object_Renaming_Declaration =>
- return True;
-
- -- All other references are definitely not lvalues
-
- when others =>
- return False;
- end case;
- end May_Be_Lvalue;
-
-----------------
-- Might_Raise --
-----------------
-- an array, either inside a loop of the form 'for X of A' or a quantified
-- expression of the form 'for all/some X of A' where A is of array type.
- type Is_LHS_Result is (Yes, No, Unknown);
- function Is_LHS (N : Node_Id) return Is_LHS_Result;
- -- Returns Yes if N is definitely used as Name in an assignment statement.
- -- Returns No if N is definitely NOT used as a Name in an assignment
- -- statement. Returns Unknown if we can't tell at this stage (happens in
- -- the case where we don't know the type of N yet, and we have something
- -- like N.A := 3, where this counts as N being used on the left side of
- -- an assignment only if N is not an access type. If it is an access type
- -- then it is N.all.A that is assigned, not N.
-
function Is_Library_Level_Entity (E : Entity_Id) return Boolean;
-- A library-level declaration is one that is accessible from Standard,
-- i.e. a library unit or an entity declared in a library package.
-- and returns True if so. Returns False otherwise. It is an error to call
-- this function if N is not of an access type.
- function Known_To_Be_Assigned (N : Node_Id) return Boolean;
+ function Known_To_Be_Assigned
+ (N : Node_Id;
+ Only_LHS : Boolean := False) return Boolean;
-- The node N is an entity reference. This function determines whether the
-- reference is for sure an assignment of the entity, returning True if
- -- so. This differs from May_Be_Lvalue in that it defaults in the other
- -- direction. Cases which may possibly be assignments but are not known to
- -- be may return True from May_Be_Lvalue, but False from this function.
+ -- so. Only_LHS will modify this behavior such that actuals for out or
+ -- in out parameters will not be considered assigned.
function Last_Source_Statement (HSS : Node_Id) return Node_Id;
-- HSS is a handled statement sequence. This function returns the last
-- same number of dimensions, and the same static bounds for each index
-- position.
- function May_Be_Lvalue (N : Node_Id) return Boolean;
- -- Determines if N could be an lvalue (e.g. an assignment left hand side).
- -- An lvalue is defined as any expression which appears in a context where
- -- a name is required by the syntax, and the identity, rather than merely
- -- the value of the node is needed (for example, the prefix of an Access
- -- attribute is in this category). Note that, as implied by the name, this
- -- test is conservative. If it cannot be sure that N is NOT an lvalue, then
- -- it returns True. It tries hard to get the answer right, but it is hard
- -- to guarantee this in all cases. Note that it is more possible to give
- -- correct answer if the tree is fully analyzed.
-
function Might_Raise (N : Node_Id) return Boolean;
-- True if evaluation of N might raise an exception. This is conservative;
-- if we're not sure, we return True. If N is a subprogram body, this is
-- If this is an lvalue, then definitely abandon, since
-- this could be a direct modification of the variable.
- if May_Be_Lvalue (N) then
+ if Known_To_Be_Assigned (N) then
return Abandon;
end if;
and then Present (Renamed_Object (Entity (N)))
and then Is_Entity_Name (Renamed_Object (Entity (N)))
and then Entity (Renamed_Object (Entity (N))) = Var
- and then May_Be_Lvalue (N)
+ and then Known_To_Be_Assigned (N)
then
return Abandon;
if Nkind (Parent (LA)) in N_Parameter_Association
| N_Procedure_Call_Statement
then
- Error_Msg_NE
- ("?m?& modified by call, but value might not be "
- & "referenced", LA, Ent);
-
+ if Warn_On_All_Unread_Out_Parameters then
+ Error_Msg_NE
+ ("?m?& modified by call, but value might not "
+ & "be referenced", LA, Ent);
+ end if;
else
Error_Msg_NE -- CODEFIX
("?m?possibly useless assignment to&, value "
git://gcc.gnu.org / gcc.git / commitdiff