sem_dist.ads, [...] (Is_RACW_Stub_Type_Operation): New subprogram.
2008-05-20 Thomas Quinot <quinot@adacore.com> * sem_dist.ads, sem_dist.adb (Is_RACW_Stub_Type_Operation): New subprogram. * sem_type.adb (Add_One_Interp): Ignore any interpretation that is a primitive operation of an RACW stub type (these primitives are only executed through dispatching, never through static calls). (Collect_Interps): When only one interpretation has been found, set N's Entity and Etype to that interpretation, otherwise Entity and Etype may still refer to an interpretation that was ignored by Add_One_Interp, in which case would end up with being marked as not overloaded but with an Entity attribute not pointing to its (unique) correct interpretation. From-SVN: r135642
This commit is contained in:
parent
ff81221b5b
commit
4b1c635450
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2008, 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- --
|
||||
|
@ -35,6 +35,7 @@ with Namet; use Namet;
|
|||
with Opt; use Opt;
|
||||
with Rtsfind; use Rtsfind;
|
||||
with Sem; use Sem;
|
||||
with Sem_Disp; use Sem_Disp;
|
||||
with Sem_Eval; use Sem_Eval;
|
||||
with Sem_Res; use Sem_Res;
|
||||
with Sem_Util; use Sem_Util;
|
||||
|
@ -268,12 +269,33 @@ package body Sem_Dist is
|
|||
end if;
|
||||
end Is_All_Remote_Call;
|
||||
|
||||
---------------------------------
|
||||
-- Is_RACW_Stub_Type_Operation --
|
||||
---------------------------------
|
||||
|
||||
function Is_RACW_Stub_Type_Operation (Op : Entity_Id) return Boolean is
|
||||
Dispatching_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
case Ekind (Op) is
|
||||
when E_Function | E_Procedure =>
|
||||
Dispatching_Type := Find_Dispatching_Type (Op);
|
||||
return Present (Dispatching_Type)
|
||||
and then Is_RACW_Stub_Type (Dispatching_Type)
|
||||
and then not Is_Internal (Op);
|
||||
|
||||
when others =>
|
||||
return False;
|
||||
end case;
|
||||
end Is_RACW_Stub_Type_Operation;
|
||||
|
||||
------------------------------------
|
||||
-- Package_Specification_Of_Scope --
|
||||
------------------------------------
|
||||
|
||||
function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id is
|
||||
N : Node_Id := Parent (E);
|
||||
|
||||
begin
|
||||
while Nkind (N) /= N_Package_Specification loop
|
||||
N := Parent (N);
|
||||
|
|
|
@ -100,4 +100,7 @@ package Sem_Dist is
|
|||
function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id;
|
||||
-- Return the N_Package_Specification corresponding to a scope E
|
||||
|
||||
function Is_RACW_Stub_Type_Operation (Op : Entity_Id) return Boolean;
|
||||
-- True when Op is a primitive operation of an RACW stub type
|
||||
|
||||
end Sem_Dist;
|
||||
|
|
|
@ -39,6 +39,7 @@ with Sem_Ch6; use Sem_Ch6;
|
|||
with Sem_Ch8; use Sem_Ch8;
|
||||
with Sem_Ch12; use Sem_Ch12;
|
||||
with Sem_Disp; use Sem_Disp;
|
||||
with Sem_Dist; use Sem_Dist;
|
||||
with Sem_Util; use Sem_Util;
|
||||
with Stand; use Stand;
|
||||
with Sinfo; use Sinfo;
|
||||
|
@ -403,10 +404,9 @@ package body Sem_Type is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- In an instance, an abstract non-dispatching operation cannot
|
||||
-- be a candidate interpretation, because it could not have been
|
||||
-- one in the generic (it may be a spurious overloading in the
|
||||
-- instance).
|
||||
-- In an instance, an abstract non-dispatching operation cannot be a
|
||||
-- candidate interpretation, because it could not have been one in the
|
||||
-- generic (it may be a spurious overloading in the instance).
|
||||
|
||||
elsif In_Instance
|
||||
and then Is_Overloadable (E)
|
||||
|
@ -415,9 +415,9 @@ package body Sem_Type is
|
|||
then
|
||||
return;
|
||||
|
||||
-- An inherited interface operation that is implemented by some
|
||||
-- derived type does not participate in overload resolution, only
|
||||
-- the implementation operation does.
|
||||
-- An inherited interface operation that is implemented by some derived
|
||||
-- type does not participate in overload resolution, only the
|
||||
-- implementation operation does.
|
||||
|
||||
elsif Is_Hidden (E)
|
||||
and then Is_Subprogram (E)
|
||||
|
@ -438,6 +438,12 @@ package body Sem_Type is
|
|||
end if;
|
||||
|
||||
return;
|
||||
|
||||
-- Calling stubs for an RACW operation never participate in resolution,
|
||||
-- they are executed only through dispatching calls.
|
||||
|
||||
elsif Is_RACW_Stub_Type_Operation (E) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If this is the first interpretation of N, N has type Any_Type.
|
||||
|
@ -681,9 +687,15 @@ package body Sem_Type is
|
|||
|
||||
if All_Interp.Last = First_Interp + 1 then
|
||||
|
||||
-- The original interpretation is in fact not overloaded
|
||||
-- The final interpretation is in fact not overloaded. Note that the
|
||||
-- unique legal interpretation may or may not be the original one,
|
||||
-- so we need to update N's entity and etype now, because once N
|
||||
-- is marked as not overloaded it is also expected to carry the
|
||||
-- proper interpretation.
|
||||
|
||||
Set_Is_Overloaded (N, False);
|
||||
Set_Entity (N, All_Interp.Table (First_Interp).Nam);
|
||||
Set_Etype (N, All_Interp.Table (First_Interp).Typ);
|
||||
end if;
|
||||
end Collect_Interps;
|
||||
|
||||
|
|
Loading…
Reference in New Issue