[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.
This commit is contained in:
Javier Miranda 2020-06-18 16:07:52 -04:00 committed by Pierre-Marie de Rodat
parent 04c4a5101b
commit abd4c42269
3 changed files with 63 additions and 10 deletions

View File

@ -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.
-- Comment here??? what set of cases???
if not In_Instance then
Error_Msg_N
("both component types in a view conversion must"
& " be aliased, or neither", A);
end if;
-- Check RM 4.6 (24/3)
elsif not Same_Ancestor (Etype (F), Expr_Typ) then
-- Check view conv between unrelated by ref array

View File

@ -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 --
---------------------------

View File

@ -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