Commit 3c19e9be by Ed Schonberg Committed by Arnaud Charlet

sem_ch8,adb (Analyze_Object_Renaming): Reject ambiguous expressions in an object…

sem_ch8,adb (Analyze_Object_Renaming): Reject ambiguous expressions in an object renaming declaration when...

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8,adb (Analyze_Object_Renaming): Reject ambiguous expressions
	in an object renaming declaration when the expected type is an
	anonymous access type.

	* sem_type.adb (Disambiguate): Use anonymousness to resolve a potential
	ambiguity when one interpretation is an anonymous access type and the
	other is a named access type, and the context itself is anonymous

From-SVN: r146404
parent 5e9579b4
...@@ -782,25 +782,50 @@ package body Sem_Ch8 is ...@@ -782,25 +782,50 @@ package body Sem_Ch8 is
Error_Msg_N Error_Msg_N
("expect anonymous access type in object renaming", N); ("expect anonymous access type in object renaming", N);
end if; end if;
else else
declare declare
I : Interp_Index; I : Interp_Index;
It : Interp; It : Interp;
Typ : Entity_Id := Empty; Typ : Entity_Id := Empty;
Seen : Boolean := False;
begin begin
Get_First_Interp (Nam, I, It); Get_First_Interp (Nam, I, It);
while Present (It.Typ) loop while Present (It.Typ) loop
if No (Typ) then
if Ekind (It.Typ) = Ekind (T) -- Renaming is ambiguous if more than one candidate
and then Covers (T, It.Typ) -- interpretation is type-conformant with the context.
if Ekind (It.Typ) = Ekind (T) then
if Ekind (T) = E_Anonymous_Access_Subprogram_Type
and then Type_Conformant
(Designated_Type (T), Designated_Type (It.Typ))
then
if not Seen then
Seen := True;
else
Error_Msg_N
("ambiguous expression in renaming", Nam);
end if;
elsif Ekind (T) = E_Anonymous_Access_Type
and then Covers
(Designated_Type (T), Designated_Type (It.Typ))
then then
if not Seen then
Seen := True;
else
Error_Msg_N
("ambiguous expression in renaming", Nam);
end if;
end if;
if Covers (T, It.Typ) then
Typ := It.Typ; Typ := It.Typ;
Set_Etype (Nam, Typ); Set_Etype (Nam, Typ);
Set_Is_Overloaded (Nam, False); Set_Is_Overloaded (Nam, False);
end if; end if;
else
Error_Msg_N ("ambiguous expression in renaming", N);
end if; end if;
Get_Next_Interp (I, It); Get_Next_Interp (I, It);
......
...@@ -1680,6 +1680,37 @@ package body Sem_Type is ...@@ -1680,6 +1680,37 @@ package body Sem_Type is
elsif Nkind (N) = N_Range then elsif Nkind (N) = N_Range then
return It1; return It1;
-- Implement AI05-105: A renaming declaration with an access
-- definition must resolve to an anonymous access type. This
-- is a resolution rule and can be used to disambiguate.
elsif Nkind (Parent (N)) = N_Object_Renaming_Declaration
and then Present (Access_Definition (Parent (N)))
then
if Ekind (It1.Typ) = E_Anonymous_Access_Type
or else Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
then
if Ekind (It2.Typ) = Ekind (It1.Typ) then
-- True ambiguity
return No_Interp;
else
return It1;
end if;
elsif Ekind (It2.Typ) = E_Anonymous_Access_Type
or else Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
then
return It2;
else
-- No legal interpretation.
return No_Interp;
end if;
-- If two user defined-subprograms are visible, it is a true ambiguity, -- If two user defined-subprograms are visible, it is a true ambiguity,
-- unless one of them is an entry and the context is a conditional or -- unless one of them is an entry and the context is a conditional or
-- timed entry call, or unless we are within an instance and this is -- timed entry call, or unless we are within an instance and this is
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment