From 97b2ffb81fdef1f0c2dc3ec337a9d9a61f3b98fc Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 12 Dec 2019 10:03:43 +0000 Subject: [PATCH] [Ada] Tighten up semantic checking for protected subprogram declarations 2019-12-12 Steve Baird gcc/ada/ * sem_ch6.adb (New_Overloaded_Entity.Check_Conforming_Paramters): Add new Conformance_Type parameter. With the value of Subtype_Conformant, the behavior of Check_Conforming_Parameters is unchanged. The call in Matching_Entry_Or_Subprogram to instead passes in Type_Conformant. This corresponds to the use of "type conformant" in Ada RM 9.4(11.4/3). (New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add new Normalized_First_Parameter_Type function to help in ignoring the distinction between protected and access-to-protected first parameters when checking prefixed-view profile matching. Replace computations of the type of the first parameter with calls to this function as appropriate. From-SVN: r279303 --- gcc/ada/ChangeLog | 16 ++++++++++++ gcc/ada/sem_ch6.adb | 59 +++++++++++++++++++++++++++++++++++---------- 2 files changed, 62 insertions(+), 13 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 11eca2c3dc7..19e7fea30b9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2019-12-12 Steve Baird + + * sem_ch6.adb + (New_Overloaded_Entity.Check_Conforming_Paramters): Add new + Conformance_Type parameter. With the value of + Subtype_Conformant, the behavior of Check_Conforming_Parameters + is unchanged. The call in Matching_Entry_Or_Subprogram to + instead passes in Type_Conformant. This corresponds to the use + of "type conformant" in Ada RM 9.4(11.4/3). + (New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add + new Normalized_First_Parameter_Type function to help in ignoring + the distinction between protected and access-to-protected first + parameters when checking prefixed-view profile matching. Replace + computations of the type of the first parameter with calls to + this function as appropriate. + 2019-12-12 Ed Schonberg * sem_ch5.adb: (Analyze_Iterator_Specification): If the diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5af3b7b7e19..988edc682b1 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10487,9 +10487,10 @@ package body Sem_Ch6 is is function Check_Conforming_Parameters (E1_Param : Node_Id; - E2_Param : Node_Id) return Boolean; + E2_Param : Node_Id; + Ctype : Conformance_Type) return Boolean; -- Starting from the given parameters, check that all the parameters - -- of two entries or subprograms are subtype conformant. Used to skip + -- of two entries or subprograms are conformant. Used to skip -- the check on the controlling argument. function Matching_Entry_Or_Subprogram @@ -10516,26 +10517,38 @@ package body Sem_Ch6 is -- whose name matches the original name of Subp and has a profile -- conformant with the profile of Subp; return Empty if not found. + function Normalized_First_Parameter_Type + (E : Entity_Id) return Entity_Id; + -- Return the type of the first parameter unless that type + -- is an anonymous access type, in which case return the + -- designated type. Used to treat anonymous-access-to-synchronized + -- the same as synchronized for purposes of checking for + -- prefixed view profile conflicts. + --------------------------------- -- Check_Conforming_Parameters -- --------------------------------- function Check_Conforming_Parameters (E1_Param : Node_Id; - E2_Param : Node_Id) return Boolean + E2_Param : Node_Id; + Ctype : Conformance_Type) return Boolean is Param_E1 : Node_Id := E1_Param; Param_E2 : Node_Id := E2_Param; begin while Present (Param_E1) and then Present (Param_E2) loop - if Ekind (Defining_Identifier (Param_E1)) /= - Ekind (Defining_Identifier (Param_E2)) - or else not + if (Ctype >= Mode_Conformant) and then + Ekind (Defining_Identifier (Param_E1)) /= + Ekind (Defining_Identifier (Param_E2)) + then + return False; + elsif not Conforming_Types (Find_Parameter_Type (Param_E1), Find_Parameter_Type (Param_E2), - Subtype_Conformant) + Ctype) then return False; end if; @@ -10568,7 +10581,8 @@ package body Sem_Ch6 is and then Check_Conforming_Parameters (First (Parameter_Specifications (Parent (E))), - Next (First (Parameter_Specifications (Parent (Subp))))) + Next (First (Parameter_Specifications (Parent (Subp)))), + Type_Conformant) then return E; end if; @@ -10608,7 +10622,8 @@ package body Sem_Ch6 is and then Check_Conforming_Parameters (First (Parameter_Specifications (Parent (Ent))), - Next (First (Parameter_Specifications (Parent (E))))) + Next (First (Parameter_Specifications (Parent (E)))), + Subtype_Conformant) then return E; end if; @@ -10662,6 +10677,21 @@ package body Sem_Ch6 is return Empty; end Matching_Original_Protected_Subprogram; + ------------------------------------- + -- Normalized_First_Parameter_Type -- + ------------------------------------- + + function Normalized_First_Parameter_Type + (E : Entity_Id) return Entity_Id + is + Result : Entity_Id := Etype (First_Entity (E)); + begin + if Ekind (Result) = E_Anonymous_Access_Type then + Result := Designated_Type (Result); + end if; + return Result; + end Normalized_First_Parameter_Type; + -- Start of processing for Has_Matching_Entry_Or_Subprogram begin @@ -10672,20 +10702,23 @@ package body Sem_Ch6 is if Comes_From_Source (E) and then Is_Subprogram (E) and then Present (First_Entity (E)) - and then Is_Concurrent_Record_Type (Etype (First_Entity (E))) + and then Is_Concurrent_Record_Type + (Normalized_First_Parameter_Type (E)) then if Scope (E) = Scope (Corresponding_Concurrent_Type - (Etype (First_Entity (E)))) + (Normalized_First_Parameter_Type (E))) and then Present (Matching_Entry_Or_Subprogram - (Corresponding_Concurrent_Type (Etype (First_Entity (E))), + (Corresponding_Concurrent_Type + (Normalized_First_Parameter_Type (E)), Subp => E)) then Report_Conflict (E, Matching_Entry_Or_Subprogram - (Corresponding_Concurrent_Type (Etype (First_Entity (E))), + (Corresponding_Concurrent_Type + (Normalized_First_Parameter_Type (E)), Subp => E)); return True; end if; -- 2.30.2