mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-23 08:19:10 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_ch6.adb (Find_Corresponding_Spec): If the previous entity is a body generated for a function with a controlling...

Browse Source 
2007-10-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Find_Corresponding_Spec): If the previous entity is a
	body generated for a function with a controlling result that is a null
	extension, discard the generated body in favor of the current explicit
	one.

From-SVN: r129336
This commit is contained in:
Ed Schonberg 2007-10-15 15:57:06 +02:00 committed by Arnaud Charlet
parent 78ee282c50
commit 81db9d770d
1 changed files with 37 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/sem_ch6.adb
View File

@ -96,8 +96,8 @@ package body Sem_Ch6 is
-- Common processing for simple_ and extended_return_statements
procedure Analyze_Function_Return (N : Node_Id);
-- Subsidiary to Analyze_Return_Statement.
-- Called when the return statement applies to a [generic] function.
-- Subsidiary to Analyze_Return_Statement. Called when the return statement
-- applies to a [generic] function.
procedure Analyze_Return_Type (N : Node_Id);
-- Subsidiary to Process_Formals: analyze subtype mark in function
@ -335,6 +335,7 @@ package body Sem_Ch6 is
End_Scope;
end if;
Kill_Current_Values (Last_Assignment_Only => True);
Check_Unreachable_Code (N);
end Analyze_Return_Statement;
@ -1979,7 +1980,6 @@ package body Sem_Ch6 is
Protected_Body_Subprogram (Spec_Id);
Prot_Ext_Formal : Entity_Id := Extra_Formals (Spec_Id);
Impl_Ext_Formal : Entity_Id := Extra_Formals (Impl_Subp);
begin
while Present (Prot_Ext_Formal) loop
pragma Assert (Present (Impl_Ext_Formal));
@ -3780,6 +3780,7 @@ package body Sem_Ch6 is
Err_Loc : Node_Id := Empty)
is
Result : Boolean;
pragma Warnings (Off, Result);
begin
Check_Conformance
(New_Id, Old_Id, Fully_Conformant, True, Result, Err_Loc);
@ -3796,7 +3797,7 @@ package body Sem_Ch6 is
Get_Inst : Boolean := False)
is
Result : Boolean;
pragma Warnings (Off, Result);
begin
Check_Conformance
(New_Id, Old_Id, Mode_Conformant, True, Result, Err_Loc, Get_Inst);
@ -4385,6 +4386,7 @@ package body Sem_Ch6 is
Err_Loc : Node_Id := Empty)
is
Result : Boolean;
pragma Warnings (Off, Result);
begin
Check_Conformance
(New_Id, Old_Id, Subtype_Conformant, True, Result, Err_Loc);
@ -4400,6 +4402,7 @@ package body Sem_Ch6 is
Err_Loc : Node_Id := Empty)
is
Result : Boolean;
pragma Warnings (Off, Result);
begin
Check_Conformance
(New_Id, Old_Id, Type_Conformant, True, Result, Err_Loc);
@ -5123,6 +5126,36 @@ package body Sem_Ch6 is
return E;
-- If E is an internal function with a controlling result
-- that was created for an operation inherited by a null
-- extension, it may be overridden by a body without a previous
-- spec (one more reason why these should be shunned). In that
-- case remove the generated body, because the current one is
-- the explicit overriding.
elsif Ekind (E) = E_Function
and then Ada_Version >= Ada_05
and then not Comes_From_Source (E)
and then Has_Controlling_Result (E)
and then Is_Null_Extension (Etype (E))
and then Comes_From_Source (Spec)
then
Set_Has_Completion (E, False);
if Expander_Active then
Remove
(Unit_Declaration_Node
(Corresponding_Body (Unit_Declaration_Node (E))));
return E;
-- If expansion is disabled, the wrapper function has not
-- been generated, and this is the standard case of a late
-- body overriding an inherited operation.
else
return Empty;
end if;
-- If body already exists, this is an error unless the
-- previous declaration is the implicit declaration of
-- a derived subprogram, or this is a spurious overloading
@ -7032,7 +7065,6 @@ package body Sem_Ch6 is
Next (Param_Spec);
end loop;
end Process_Formals;
----------------------------