Kind : Entity_Kind;
-- If Formal is non-Empty, then its Ekind, otherwise E_Void
+ function Get_Through_Renamings (E : Entity_Id) return Entity_Id;
+ -- 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:
-- exceptions where we do not want to set this flag, see body for
-- details of these exceptional cases.
+ ---------------------------
+ -- Get_Through_Renamings --
+ ---------------------------
+
+ function Get_Through_Renamings (E : Entity_Id) return Entity_Id is
+ Result : Entity_Id := E;
+ begin
+ while Present (Result)
+ and then Is_Object (Result)
+ and then Present (Renamed_Object (Result))
+ loop
+ Result := Get_Enclosing_Object (Renamed_Object (Result));
+ end loop;
+ return Result;
+ end Get_Through_Renamings;
+
---------------
-- Is_On_LHS --
---------------
return False;
end if;
end if;
+
+ -- A reference to a formal in a named parameter association does
+ -- not make the formal referenced. Formals that are unused in the
+ -- subprogram body are properly flagged as such, even if calls
+ -- elsewhere use named notation.
+
+ elsif Nkind (P) = N_Parameter_Association
+ and then N = Selector_Name (P)
+ then
+ return False;
end if;
end if;
-- doing in such cases. For example the calls in Ada.Characters.Handling
-- to its own obsolescent subprograms are just fine.
- -- In any case we do not generate warnings within the extended source
- -- unit of the entity in question, since we assume the source unit
- -- itself knows what is going on (and for sure we do not want silly
- -- warnings, e.g. on the end line of an obsolescent procedure body).
+ -- In any case we only generate warnings if we are in the extended main
+ -- source unit, and the entity itself is not in the extended main source
+ -- unit, since we assume the source unit itself knows what is going on
+ -- (and for sure we do not want silly warnings, e.g. on the end line of
+ -- an obsolescent procedure body).
if Is_Obsolescent (E)
and then not GNAT_Mode
and then not In_Extended_Main_Source_Unit (E)
+ and then In_Extended_Main_Source_Unit (N)
then
Check_Restriction (No_Obsolescent_Features, N);
return;
end if;
+ -- In Alfa mode, consider the underlying entity renamed instead of
+ -- the renaming, which is needed to compute a valid set of effects
+ -- (reads, writes) for the enclosing subprogram.
+
+ if Alfa_Mode then
+ Ent := Get_Through_Renamings (Ent);
+
+ -- If no enclosing object, then it could be a reference to any
+ -- location not tracked individually, like heap-allocated data.
+ -- Conservatively approximate this possibility by generating a
+ -- dereference, and return.
+
+ if No (Ent) then
+ if Actual_Typ = 'w' then
+ Alfa.Generate_Dereference (Nod, 'r');
+ Alfa.Generate_Dereference (Nod, 'w');
+ else
+ Alfa.Generate_Dereference (Nod, 'r');
+ end if;
+
+ return;
+ end if;
+ end if;
+
-- Record reference to entity
Ref := Original_Location (Sloc (Nod));
if Alfa_Mode then
Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (N);
Ent_Scope := Alfa.Enclosing_Subprogram_Or_Package (Ent);
- Ent_Scope_File := Get_Source_Unit (Ent_Scope);
+ -- Since we are reaching through renamings in Alfa mode, we may
+ -- end up with standard constants. Ignore those.
+
+ if Sloc (Ent_Scope) <= Standard_Location
+ or else Def <= Standard_Location
+ then
+ return;
+ end if;
+
+ Ent_Scope_File := Get_Source_Unit (Ent_Scope);
else
Ref_Scope := Empty;
Ent_Scope := Empty;
procedure Output_Import_Export_Info (Ent : Entity_Id);
-- Output language and external name information for an interfaced
- -- entity, using the format <language, external_name>
+ -- entity, using the format <language, external_name>.
------------------------
-- Get_Type_Reference --
Op := Ultimate_Alias (Old_E);
- -- Normal case of no alias present
+ -- Normal case of no alias present. We omit generated
+ -- primitives like tagged equality, that have no source
+ -- representation.
else
Op := Old_E;
if Present (Op)
and then Sloc (Op) /= Standard_Location
+ and then Comes_From_Source (Op)
then
declare
Loc : constant Source_Ptr := Sloc (Op);
OSDN Git Service
