[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.

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4dc19f35a86977925655564df3cd04271cf93849..50a4287d9ce174bd0f8ae2689e30ea94d4666dd3 100644 (file)
--- 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 917538258510356cec9bfe80539ef4d47e74561a..679b3beb67b1bcc801a87e3967db3b9a505d2f0f 100644 (file)
--- 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 9e62170e8f6c908bea8c590def02bfd70d81cc60..a6bd6e2a02cab1f6e8758fdac4fc939597c2529f 100644 (file)
--- 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