aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2018-07-17 08:13:28 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-07-17 08:13:28 +0000
commit118f2d8bc3e6804996ca2953b86454ec950054bf (patch)
tree86e45eb96a5f6af1683a831858de4d7b4844ac5d /gcc/ada
parent5b4f211d2a7f41f147413d0b756ffe56aec78230 (diff)
downloadgcc-118f2d8bc3e6804996ca2953b86454ec950054bf.zip
gcc-118f2d8bc3e6804996ca2953b86454ec950054bf.tar.gz
gcc-118f2d8bc3e6804996ca2953b86454ec950054bf.tar.bz2
[Ada] Spurious error on prefixed call in an instantiation
This patch fixes a spurious error on a prefixed call in an instance, when the generic parameters include an interface type and an abstract operation of that type, and the actuals in the instance include an interface type and a corresponding abstract operation of it, with a different name than the corresponding generic subprogram parameter. The patch also fixes a similar error involving class-wide operations and generic private types. 2018-07-17 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * sem_ch4.adb (Try_Object_Operation): Handle properly a prefixed call in an instance, when the generic parameters include an interface type and a abstract operation of that type, and the actuals in the instance include an interface type and a corresponding abstract operation of it, with a different name than the corresponding generic subprogram parameter. gcc/testsuite/ * gnat.dg/generic_call_cw.adb, gnat.dg/generic_call_iface.adb: New testcase. From-SVN: r262803
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/sem_ch4.adb87
2 files changed, 74 insertions, 22 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 21b7bb8..2375e80a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-07-17 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Try_Object_Operation): Handle properly a prefixed call
+ in an instance, when the generic parameters include an interface type
+ and a abstract operation of that type, and the actuals in the instance
+ include an interface type and a corresponding abstract operation of it,
+ with a different name than the corresponding generic subprogram
+ parameter.
+
2018-07-17 Arnaud Charlet <charlet@adacore.com>
* sem_eval.adb (Rewrite_In_Raise_CE): Keep the original reason in more
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index def317d9..597ec1e 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -8928,11 +8928,38 @@ package body Sem_Ch4 is
(Anc_Type : Entity_Id;
Error : out Boolean)
is
+ Candidate : Entity_Id;
+ -- If homonym is a renaming, examine the renamed program
+
Cls_Type : Entity_Id;
Hom : Entity_Id;
Hom_Ref : Node_Id;
Success : Boolean;
+ function First_Formal_Match
+ (Typ : Entity_Id) return Boolean;
+ -- Predicate to verify that the first formal of a class-wide
+ -- candidate matches the type of the prefix.
+
+ ------------------------
+ -- First_Formal_Match --
+ ------------------------
+
+ function First_Formal_Match
+ (Typ : Entity_Id) return Boolean
+ is
+ Ctrl : constant Entity_Id := First_Formal (Candidate);
+ begin
+ return Present (Ctrl)
+ and then
+ (Base_Type (Etype (Ctrl)) = Typ
+ or else
+ (Ekind (Etype (Ctrl)) = E_Anonymous_Access_Type
+ and then
+ Base_Type
+ (Designated_Type (Etype (Ctrl))) = Typ));
+ end First_Formal_Match;
+
begin
Error := False;
@@ -8948,25 +8975,23 @@ package body Sem_Ch4 is
while Present (Hom) loop
if Ekind_In (Hom, E_Procedure, E_Function)
- and then (not Is_Hidden (Hom) or else In_Instance)
- and then Scope (Hom) = Scope (Base_Type (Anc_Type))
- and then Present (First_Formal (Hom))
- and then
- (Base_Type (Etype (First_Formal (Hom))) = Cls_Type
- or else
- (Is_Access_Type (Etype (First_Formal (Hom)))
- and then
- Ekind (Etype (First_Formal (Hom))) =
- E_Anonymous_Access_Type
- and then
- Base_Type
- (Designated_Type (Etype (First_Formal (Hom)))) =
- Cls_Type))
+ and then Present (Renamed_Entity (Hom))
+ and then Is_Generic_Actual_Subprogram (Hom)
+ then
+ Candidate := Renamed_Entity (Hom);
+ else
+ Candidate := Hom;
+ end if;
+
+ if Ekind_In (Candidate, E_Procedure, E_Function)
+ and then (not Is_Hidden (Candidate) or else In_Instance)
+ and then Scope (Candidate) = Scope (Base_Type (Anc_Type))
+ and then First_Formal_Match (Cls_Type)
then
-- If the context is a procedure call, ignore functions
-- in the name of the call.
- if Ekind (Hom) = E_Function
+ if Ekind (Candidate) = E_Function
and then Nkind (Parent (N)) = N_Procedure_Call_Statement
and then N = Name (Parent (N))
then
@@ -8975,7 +9000,7 @@ package body Sem_Ch4 is
-- If the context is a function call, ignore procedures
-- in the name of the call.
- elsif Ekind (Hom) = E_Procedure
+ elsif Ekind (Candidate) = E_Procedure
and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
then
goto Next_Hom;
@@ -8986,7 +9011,7 @@ package body Sem_Ch4 is
Success := False;
if No (Matching_Op) then
- Hom_Ref := New_Occurrence_Of (Hom, Sloc (Subprog));
+ Hom_Ref := New_Occurrence_Of (Candidate, Sloc (Subprog));
Set_Etype (Call_Node, Any_Type);
Set_Parent (Call_Node, Parent (Node_To_Replace));
@@ -8994,18 +9019,18 @@ package body Sem_Ch4 is
Analyze_One_Call
(N => Call_Node,
- Nam => Hom,
+ Nam => Candidate,
Report => Report_Error,
Success => Success,
Skip_First => True);
Matching_Op :=
- Valid_Candidate (Success, Call_Node, Hom);
+ Valid_Candidate (Success, Call_Node, Candidate);
else
Analyze_One_Call
(N => Call_Node,
- Nam => Hom,
+ Nam => Candidate,
Report => Report_Error,
Success => Success,
Skip_First => True);
@@ -9014,9 +9039,10 @@ package body Sem_Ch4 is
-- traversals, before and after looking at interfaces.
-- Check for this case before reporting a real ambiguity.
- if Present (Valid_Candidate (Success, Call_Node, Hom))
+ if Present
+ (Valid_Candidate (Success, Call_Node, Candidate))
and then Nkind (Call_Node) /= N_Function_Call
- and then Hom /= Matching_Op
+ and then Candidate /= Matching_Op
then
Error_Msg_NE ("ambiguous call to&", N, Hom);
Report_Ambiguity (Matching_Op);
@@ -9478,6 +9504,23 @@ package body Sem_Ch4 is
Present (Original_Protected_Subprogram (Prim_Op))
and then Chars (Original_Protected_Subprogram (Prim_Op)) =
Chars (Subprog);
+
+ -- In an instance, the selector name may be a generic actual that
+ -- renames a primitive operation of the type of the prefix.
+
+ elsif In_Instance and then Present (Current_Entity (Subprog)) then
+ declare
+ Subp : constant Entity_Id := Current_Entity (Subprog);
+ begin
+ if Present (Subp)
+ and then Is_Subprogram (Subp)
+ and then Present (Renamed_Entity (Subp))
+ and then Is_Generic_Actual_Subprogram (Subp)
+ and then Chars (Renamed_Entity (Subp)) = Chars (Prim_Op)
+ then
+ return True;
+ end if;
+ end;
end if;
return False;