From abd4c42269b6a64fa9019e4d9d94730533e06f9a Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 18 Jun 2020 16:07:52 -0400 Subject: [PATCH] [Ada] Ada2020: AI12-0027 Access values and unaliased component gcc/ada/ * sem_res.adb (Resolve_Actuals): Restrict the check on matching aliased components to view conversions of array types that are not placed in an instance. In such case at runtime an object is created. * sem_util.ads (Is_Actual_In_Out_Parameter, Is_View_Conversion): New subprograms. * sem_util.adb (Is_Actual_In_Out_Parameter, Is_View_Conversion): New subprograms. --- gcc/ada/sem_res.adb | 26 ++++++++++++++++---------- gcc/ada/sem_util.adb | 37 +++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 10 ++++++++++ 3 files changed, 63 insertions(+), 10 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4dc19f3..50a4287 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4112,27 +4112,33 @@ package body Sem_Res is then declare Expr_Typ : constant Entity_Id := Etype (Expression (A)); + begin - if Ekind (F) = E_In_Out_Parameter - and then Is_Array_Type (Etype (F)) + -- Check RM 4.6 (24.2/2) + + if Is_Array_Type (Etype (F)) + and then Is_View_Conversion (A) then -- In a view conversion, the conversion must be legal in -- both directions, and thus both component types must be -- aliased, or neither (4.6 (8)). - -- The extra rule in 4.6 (24.9.2) seems unduly - -- restrictive: the privacy requirement should not apply - -- to generic types, and should be checked in an - -- instance. ARG query is in order ??? + -- Check RM 4.6 (24.8/2) if Has_Aliased_Components (Expr_Typ) /= Has_Aliased_Components (Etype (F)) then - Error_Msg_N - ("both component types in a view conversion must be" - & " aliased, or neither", A); + -- This normally illegal conversion is legal in an + -- expanded instance body because of RM 12.3(11). + -- At runtime, conversion must create a new object. + + if not In_Instance then + Error_Msg_N + ("both component types in a view conversion must" + & " be aliased, or neither", A); + end if; - -- Comment here??? what set of cases??? + -- Check RM 4.6 (24/3) elsif not Same_Ancestor (Etype (F), Expr_Typ) then -- Check view conv between unrelated by ref array diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9175382..679b3be 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14276,6 +14276,18 @@ package body Sem_Util is return Present (Formal) and then Ekind (Formal) = E_Out_Parameter; end Is_Actual_Out_Parameter; + -------------------------------- + -- Is_Actual_In_Out_Parameter -- + -------------------------------- + + function Is_Actual_In_Out_Parameter (N : Node_Id) return Boolean is + Formal : Entity_Id; + Call : Node_Id; + begin + Find_Actual (N, Formal, Call); + return Present (Formal) and then Ekind (Formal) = E_In_Out_Parameter; + end Is_Actual_In_Out_Parameter; + ------------------------- -- Is_Actual_Parameter -- ------------------------- @@ -19464,6 +19476,31 @@ package body Sem_Util is end if; end Is_Variable; + ------------------------ + -- Is_View_Conversion -- + ------------------------ + + function Is_View_Conversion (N : Node_Id) return Boolean is + begin + if Nkind (N) = N_Type_Conversion + and then Nkind (Unqual_Conv (N)) = N_Identifier + then + if Is_Tagged_Type (Etype (N)) + and then Is_Tagged_Type (Etype (Unqual_Conv (N))) + then + return True; + + elsif Is_Actual_Parameter (N) + and then (Is_Actual_Out_Parameter (N) + or else Is_Actual_In_Out_Parameter (N)) + then + return True; + end if; + end if; + + return False; + end Is_View_Conversion; + --------------------------- -- Is_Visibly_Controlled -- --------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 9e62170..a6bd6e2 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1589,6 +1589,10 @@ package Sem_Util is -- True if E is the constructed wrapper for an access_to_subprogram -- type with Pre/Postconditions. + function Is_Actual_In_Out_Parameter (N : Node_Id) return Boolean; + -- Determines if N is an actual parameter of in-out mode in a subprogram + -- call + function Is_Actual_Out_Parameter (N : Node_Id) return Boolean; -- Determines if N is an actual parameter of out mode in a subprogram call @@ -2188,6 +2192,12 @@ package Sem_Util is -- default is True since this routine is commonly invoked as part of the -- semantic analysis and it must not be disturbed by the rewriten nodes. + function Is_View_Conversion (N : Node_Id) return Boolean; + -- Returns True if N is a type_conversion whose operand is the name of an + -- object and both its target type and operand type are tagged, or it + -- appears in a call as an actual parameter of mode out or in out + -- (RM 4.6(5/2)). + function Is_Visibly_Controlled (T : Entity_Id) return Boolean; -- Check whether T is derived from a visibly controlled type. This is true -- if the root type is declared in Ada.Finalization. If T is derived -- 2.7.4