Commit e65f50ec by Ed Schonberg Committed by Arnaud Charlet

sem_res.adb (Resolve_Call): If the call is dispatching...

2007-09-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): If the call is dispatching, generate the
	proper kind of reference to the primitive operation, for better source
	navigation.
	(Valid_Conversion): A tagged conversion is legal if both operands are
	tagged.

From-SVN: r128804
parent 45c8b94b
...@@ -2843,6 +2843,8 @@ package body Sem_Res is ...@@ -2843,6 +2843,8 @@ package body Sem_Res is
return; return;
end if; end if;
-- Case where actual is present
if Present (A) if Present (A)
and then (Nkind (Parent (A)) /= N_Parameter_Association and then (Nkind (Parent (A)) /= N_Parameter_Association
or else or else
...@@ -4331,7 +4333,6 @@ package body Sem_Res is ...@@ -4331,7 +4333,6 @@ package body Sem_Res is
elsif not (Is_Type (Entity (Subp))) then elsif not (Is_Type (Entity (Subp))) then
Nam := Entity (Subp); Nam := Entity (Subp);
Set_Entity_With_Style_Check (Subp, Nam); Set_Entity_With_Style_Check (Subp, Nam);
Generate_Reference (Nam, Subp);
-- Otherwise we must have the case of an overloaded call -- Otherwise we must have the case of an overloaded call
...@@ -4344,7 +4345,6 @@ package body Sem_Res is ...@@ -4344,7 +4345,6 @@ package body Sem_Res is
if Covers (Typ, It.Typ) then if Covers (Typ, It.Typ) then
Nam := It.Nam; Nam := It.Nam;
Set_Entity_With_Style_Check (Subp, Nam); Set_Entity_With_Style_Check (Subp, Nam);
Generate_Reference (Nam, Subp);
exit; exit;
end if; end if;
...@@ -4378,7 +4378,7 @@ package body Sem_Res is ...@@ -4378,7 +4378,7 @@ package body Sem_Res is
Make_Raise_Program_Error (Loc, Make_Raise_Program_Error (Loc,
Reason => PE_Current_Task_In_Entry_Body)); Reason => PE_Current_Task_In_Entry_Body));
Set_Etype (N, Rtype); Set_Etype (N, Rtype);
exit; return;
end if; end if;
end loop; end loop;
end; end;
...@@ -4744,6 +4744,7 @@ package body Sem_Res is ...@@ -4744,6 +4744,7 @@ package body Sem_Res is
-- Avoid validation, since it is a static function call -- Avoid validation, since it is a static function call
Generate_Reference (Nam, Subp);
return; return;
end if; end if;
...@@ -4788,6 +4789,17 @@ package body Sem_Res is ...@@ -4788,6 +4789,17 @@ package body Sem_Res is
Error_Msg_NE ("cannot call abstract subprogram &!", N, Nam); Error_Msg_NE ("cannot call abstract subprogram &!", N, Nam);
end if; end if;
-- If this is a dispatching call, generate the appropriate reference,
-- for better source navigation in GPS.
if Is_Overloadable (Nam)
and then Present (Controlling_Argument (N))
then
Generate_Reference (Nam, Subp, 'R');
else
Generate_Reference (Nam, Subp);
end if;
if Is_Intrinsic_Subprogram (Nam) then if Is_Intrinsic_Subprogram (Nam) then
Check_Intrinsic_Call (N); Check_Intrinsic_Call (N);
end if; end if;
...@@ -8677,7 +8689,8 @@ package body Sem_Res is ...@@ -8677,7 +8689,8 @@ package body Sem_Res is
return Valid_Array_Conversion; return Valid_Array_Conversion;
end if; end if;
-- Anonymous access types where target references an interface -- Ada 2005 (AI-251): Anonymous access types where target references an
-- interface type.
elsif (Ekind (Target_Type) = E_General_Access_Type elsif (Ekind (Target_Type) = E_General_Access_Type
or else or else
...@@ -9020,9 +9033,11 @@ package body Sem_Res is ...@@ -9020,9 +9033,11 @@ package body Sem_Res is
N); N);
return True; return True;
-- Tagged types -- If both are tagged types, check legality of view conversions
elsif Is_Tagged_Type (Target_Type) then elsif Is_Tagged_Type (Target_Type)
and then Is_Tagged_Type (Opnd_Type)
then
return Valid_Tagged_Conversion (Target_Type, Opnd_Type); return Valid_Tagged_Conversion (Target_Type, Opnd_Type);
-- Types derived from the same root type are convertible -- Types derived from the same root type are convertible
......
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