From acf624f28032bb0fa8bee97d506c73c281f15ca6 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 2 Mar 2015 11:05:03 +0000 Subject: [PATCH] sem_ch6.adb (Check_Private_Overriding): Refine the legality checks here. 2015-03-02 Bob Duff * sem_ch6.adb (Check_Private_Overriding): Refine the legality checks here. It used to check that the function is merely overriding SOMEthing. Now it checks that the function is overriding a corresponding public operation. This is a correction to the implementation of the rule in RM-3.9.3(10). From-SVN: r221110 --- gcc/ada/ChangeLog | 8 ++++++ gcc/ada/sem_ch6.adb | 60 +++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 66 insertions(+), 2 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0a4d3f9bf12..01787e449bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2015-03-02 Bob Duff + + * sem_ch6.adb (Check_Private_Overriding): Refine the legality + checks here. It used to check that the function is merely + overriding SOMEthing. Now it checks that the function is + overriding a corresponding public operation. This is a correction + to the implementation of the rule in RM-3.9.3(10). + 2015-03-02 Robert Dewar * debug.adb: Document new debug flag -gnatd.1. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index dccecc34be0..39cd353ea5e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8905,6 +8905,50 @@ package body Sem_Ch6 is ------------------------------ procedure Check_Private_Overriding (T : Entity_Id) is + + function Overrides_Visible_Function return Boolean; + -- True if S overrides a function in the visible part. The + -- overridden function could be explicitly or implicitly declared. + + function Overrides_Visible_Function return Boolean is + begin + if not Is_Overriding or else not Has_Homonym (S) then + return False; + end if; + + if not Present (Incomplete_Or_Partial_View (T)) then + return True; + end if; + + -- Search through all the homonyms H of S in the current + -- package spec, and return True if we find one that matches. + -- Note that Parent (H) will be the declaration of the + -- Incomplete_Or_Partial_View of T for a match. + + declare + H : Entity_Id := S; + begin + loop + H := Homonym (H); + exit when not Present (H) or else Scope (H) /= Scope (S); + + if Nkind_In + (Parent (H), + N_Private_Extension_Declaration, + N_Private_Type_Declaration) + and then Defining_Identifier (Parent (H)) = + Incomplete_Or_Partial_View (T) + then + return True; + end if; + end loop; + end; + + return False; + end Overrides_Visible_Function; + + -- Start of processing for Check_Private_Overriding + begin if Is_Package_Or_Generic_Package (Current_Scope) and then In_Private_Part (Current_Scope) @@ -8919,8 +8963,20 @@ package body Sem_Ch6 is Error_Msg_N ("abstract subprograms must be visible " & "(RM 3.9.3(10))!", S); - elsif Ekind (S) = E_Function and then not Is_Overriding then - if Is_Tagged_Type (T) and then T = Base_Type (Etype (S)) then + elsif Ekind (S) = E_Function + and then not Overrides_Visible_Function + then + -- Here, S is "function ... return T;" declared in the + -- private part, not overriding some visible operation. + -- That's illegal in the tagged case (but not if the + -- private type is untagged). + + if ((Present (Incomplete_Or_Partial_View (T)) + and then Is_Tagged_Type (Incomplete_Or_Partial_View (T))) + or else (not Present (Incomplete_Or_Partial_View (T)) + and then Is_Tagged_Type (T))) + and then T = Base_Type (Etype (S)) + then Error_Msg_N ("private function with tagged result must" & " override visible-part function", S); Error_Msg_N ("\move subprogram to the visible part"