aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/sem_dist.adb24
-rw-r--r--gcc/ada/sem_dist.ads3
-rw-r--r--gcc/ada/sem_type.adb28
3 files changed, 46 insertions, 9 deletions
diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb
index 50cf65a..0be68ed 100644
--- a/gcc/ada/sem_dist.adb
+++ b/gcc/ada/sem_dist.adb
@@ -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);
diff --git a/gcc/ada/sem_dist.ads b/gcc/ada/sem_dist.ads
index 9f9b95d..38a164a 100644
--- a/gcc/ada/sem_dist.ads
+++ b/gcc/ada/sem_dist.ads
@@ -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;
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index b118c37..c36125f 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -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;