[Ada] Small cleanup in handling of Ada 2012 implicit dereferences

2020-06-12  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_ch4.adb (Try_Container_Indexing): Replace call to
	First_Discriminant by Get_Reference_Discriminant to get the
	reference discriminant.
	* sem_ch13.adb (Check_Indexing_Functions): Likewise.
	* sem_ch5.adb (Preanalyze_Range): Call Get_Reference_Discriminant
	to get the reference discriminant.
	* sem_util.adb (Is_OK_Variable_For_Out_Formal): Treat all
	Ada 2012 implicit dereferences in only one place.
	(Is_Variable): Minor tweak.

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4b042d8..e9473af 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4759,9 +4759,10 @@ package body Sem_Ch13 is
                end if;
 
             else
-               if  Has_Implicit_Dereference (Ret_Type)
+               if Has_Implicit_Dereference (Ret_Type)
                  and then not
-                   Is_Access_Constant (Etype (First_Discriminant (Ret_Type)))
+                   Is_Access_Constant
+                     (Etype (Get_Reference_Discriminant (Ret_Type)))
                then
                   Illegal_Indexing
                     ("constant indexing must return an access to constant");

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index bb0017e..7bdb0d1 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -8097,7 +8097,8 @@ package body Sem_Ch4 is
          --  as such and retry.
 
          if Has_Implicit_Dereference (Pref_Typ) then
-            Build_Explicit_Dereference (Prefix, First_Discriminant (Pref_Typ));
+            Build_Explicit_Dereference
+              (Prefix, Get_Reference_Discriminant (Pref_Typ));
             return Try_Container_Indexing (N, Prefix, Exprs);
 
          --  Otherwise this is definitely not container indexing

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 35119fb..5793902 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4375,21 +4375,8 @@ package body Sem_Ch5 is
          --  visible in the loop.
 
          elsif Has_Implicit_Dereference (Etype (R_Copy)) then
-            declare
-               Disc : Entity_Id;
-
-            begin
-               Disc := First_Discriminant (Typ);
-               while Present (Disc) loop
-                  if Has_Implicit_Dereference (Disc) then
-                     Build_Explicit_Dereference (R_Copy, Disc);
-                     exit;
-                  end if;
-
-                  Next_Discriminant (Disc);
-               end loop;
-            end;
-
+            Build_Explicit_Dereference
+              (R_Copy, Get_Reference_Discriminant (Etype (R_Copy)));
          end if;
       end if;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3ae8264..948ee60 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16915,10 +16915,9 @@ package body Sem_Util is
       --  check whether the context requires an access_to_variable type.
 
       elsif Nkind (AV) = N_Explicit_Dereference
-        and then Ada_Version >= Ada_2012
-        and then Nkind (Original_Node (AV)) = N_Indexed_Component
         and then Present (Etype (Original_Node (AV)))
         and then Has_Implicit_Dereference (Etype (Original_Node (AV)))
+        and then Ada_Version >= Ada_2012
       then
          return not Is_Access_Constant (Etype (Prefix (AV)));
 
@@ -16976,28 +16975,7 @@ package body Sem_Util is
       --  but we still want to allow the conversion if it converts a variable).
 
       elsif Is_Rewrite_Substitution (AV) then
-
-         --  In Ada 2012, the explicit dereference may be a rewritten call to a
-         --  Reference function.
-
-         if Ada_Version >= Ada_2012
-           and then Nkind (Original_Node (AV)) = N_Function_Call
-           and then
-             Has_Implicit_Dereference (Etype (Name (Original_Node (AV))))
-         then
-
-            --  Check that this is not a constant reference.
-
-            return not Is_Access_Constant (Etype (Prefix (AV)));
-
-         elsif Has_Implicit_Dereference (Etype (Original_Node (AV))) then
-            return
-              not Is_Access_Constant (Etype
-                (Get_Reference_Discriminant (Etype (Original_Node (AV)))));
-
-         else
-            return Is_OK_Variable_For_Out_Formal (Original_Node (AV));
-         end if;
+         return Is_OK_Variable_For_Out_Formal (Original_Node (AV));
 
       --  All other non-variables are rejected
 
@@ -18792,14 +18770,14 @@ package body Sem_Util is
            or else
              Is_Variable_Prefix (Original_Node (Prefix (N)));
 
-      --  in Ada 2012, the dereference may have been added for a type with
-      --  a declared implicit dereference aspect. Check that it is not an
-      --  access to constant.
+      --  Generalized indexing operations are rewritten as explicit
+      --  dereferences, and it is only during resolution that we can
+      --  check whether the context requires an access_to_variable type.
 
       elsif Nkind (N) = N_Explicit_Dereference
         and then Present (Etype (Orig_Node))
-        and then Ada_Version >= Ada_2012
         and then Has_Implicit_Dereference (Etype (Orig_Node))
+        and then Ada_Version >= Ada_2012
       then
          return not Is_Access_Constant (Etype (Prefix (N)));