===================================================================
@@ -4763,6 +4763,25 @@ package body Sem_Res is
Scop : Entity_Id;
Rtype : Entity_Id;
+ function Same_Or_Aliased_Subprograms
+ (S : Entity_Id;
+ E : Entity_Id) return Boolean;
+ -- Returns True if the subprogram entity S is the same as E or else
+ -- S is an alias of E.
+
+ function Same_Or_Aliased_Subprograms
+ (S : Entity_Id;
+ E : Entity_Id) return Boolean
+ is
+ Subp_Alias : constant Entity_Id := Alias (S);
+
+ begin
+ return S = E
+ or else (Present (Subp_Alias) and then Subp_Alias = E);
+ end Same_Or_Aliased_Subprograms;
+
+ -- Start of processing for Resolve_Call
+
begin
-- The context imposes a unique interpretation with type Typ on a
-- procedure or function call. Find the entity of the subprogram that
@@ -5095,7 +5114,7 @@ package body Sem_Res is
-- Issue warning for possible infinite recursion in the absence
-- of the No_Recursion restriction.
- if Nam = Scop
+ if Same_Or_Aliased_Subprograms (Nam, Scop)
and then not Restriction_Active (No_Recursion)
and then Check_Infinite_Recursion (N)
then
@@ -5112,7 +5131,7 @@ package body Sem_Res is
else
Scope_Loop : while Scop /= Standard_Standard loop
- if Nam = Scop then
+ if Same_Or_Aliased_Subprograms (Nam, Scop) then
-- Although in general case, recursion is not statically
-- checkable, the case of calling an immediately containing
We extend the checking for recursive calls to include the case of a subprogram that calls itself via a call to a derive subprogram. Compilation of the following package must report: derived_op_recursion.adb:7:37: violation of restriction "No_Recursion" at derived_op_recursion.ads:1 pragma Restrictions (No_Recursion); package Derived_Op_Recursion is type Int_Type is new Integer; function "*" (I1 : Int_Type; I2 : Int_Type) return Int_Type; end Derived_Op_Recursion; package body Derived_Op_Recursion is type New_Int is new Int_Type; -- Inherits user-defined "*" from Int_Type function "*" (I1 : Int_Type; I2 : Int_Type) return Int_Type is begin return Int_Type (New_Int (I1) * New_Int (I2)); -- Recursive call to "*" end "*"; end Derived_Op_Recursion; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Gary Dismukes <dismukes@adacore.com> * sem_res.adb (Resolve_Call): For infinite recursion check, test whether the called subprogram is inherited from a containing subprogram. (Same_Or_Aliased_Subprograms): New function