[Ada] Look at fullest view when checking for static types in unnesting

Message ID 20200903081615.GA117200@adacore.com
State New
Headers show
Series
  • [Ada] Look at fullest view when checking for static types in unnesting
Related show

Commit Message

Arnaud Charlet Sept. 3, 2020, 8:16 a.m.
When seeing if any bound involved in a type is an uplevel reference,
we must look at the fullest view of a type, since that's what the
backends will do.  Similarly for private types. We introduce
Get_Fullest_View for that purpose.
       
Tested on x86_64-pc-linux-gnu, committed on master

    	* sem_util.ads, sem_util.adb (Get_Fullest_View): New procedure.
    	* exp_unst.adb (Check Static_Type): Do all processing on fullest
    	view of specified type.

Patch

diff --git gcc/ada/exp_unst.adb gcc/ada/exp_unst.adb
index 29fe2e5..ffc30c3 100644
--- gcc/ada/exp_unst.adb
+++ gcc/ada/exp_unst.adb
@@ -471,21 +471,23 @@  package body Exp_Unst is
             Callee : Entity_Id;
 
             procedure Check_Static_Type
-              (T                : Entity_Id;
+              (In_T             : Entity_Id;
                N                : Node_Id;
                DT               : in out Boolean;
                Check_Designated : Boolean := False);
-            --  Given a type T, checks if it is a static type defined as a type
-            --  with no dynamic bounds in sight. If so, the only action is to
-            --  set Is_Static_Type True for T. If T is not a static type, then
-            --  all types with dynamic bounds associated with T are detected,
-            --  and their bounds are marked as uplevel referenced if not at the
-            --  library level, and DT is set True. If N is specified, it's the
-            --  node that will need to be replaced. If not specified, it means
-            --  we can't do a replacement because the bound is implicit.
-
-            --  If Check_Designated is True and T or its full view is an access
-            --  type, check whether the designated type has dynamic bounds.
+            --  Given a type In_T, checks if it is a static type defined as
+            --  a type with no dynamic bounds in sight. If so, the only
+            --  action is to set Is_Static_Type True for In_T. If In_T is
+            --  not a static type, then all types with dynamic bounds
+            --  associated with In_T are detected, and their bounds are
+            --  marked as uplevel referenced if not at the library level,
+            --  and DT is set True. If N is specified, it's the node that
+            --  will need to be replaced. If not specified, it means we
+            --  can't do a replacement because the bound is implicit.
+
+            --  If Check_Designated is True and In_T or its full view
+            --  is an access type, check whether the designated type
+            --  has dynamic bounds.
 
             procedure Note_Uplevel_Ref
               (E      : Entity_Id;
@@ -505,11 +507,13 @@  package body Exp_Unst is
             -----------------------
 
             procedure Check_Static_Type
-              (T                : Entity_Id;
+              (In_T             : Entity_Id;
                N                : Node_Id;
                DT               : in out Boolean;
                Check_Designated : Boolean := False)
             is
+               T : constant Entity_Id := Get_Fullest_View (In_T);
+
                procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
                --  N is the bound of a dynamic type. This procedure notes that
                --  this bound is uplevel referenced, it can handle references
diff --git gcc/ada/sem_util.adb gcc/ada/sem_util.adb
index 679b3be..a80cc5c 100644
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -9958,6 +9958,79 @@  package body Sem_Util is
       end if;
    end Get_Enum_Lit_From_Pos;
 
+   ----------------------
+   -- Get_Fullest_View --
+   ----------------------
+
+   function Get_Fullest_View
+     (E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id is
+   begin
+      --  Strictly speaking, the recursion below isn't necessary, but
+      --  it's both simplest and safest.
+
+      case Ekind (E) is
+         when Incomplete_Kind =>
+            if From_Limited_With (E) then
+               return Get_Fullest_View (Non_Limited_View (E), Include_PAT);
+            elsif Present (Full_View (E)) then
+               return Get_Fullest_View (Full_View (E), Include_PAT);
+            elsif Ekind (E) = E_Incomplete_Subtype then
+               return Get_Fullest_View (Etype (E));
+            end if;
+
+         when Private_Kind =>
+            if Present (Underlying_Full_View (E)) then
+               return
+                 Get_Fullest_View (Underlying_Full_View (E), Include_PAT);
+            elsif Present (Full_View (E)) then
+               return Get_Fullest_View (Full_View (E), Include_PAT);
+            elsif Etype (E) /= E then
+               return Get_Fullest_View (Etype (E), Include_PAT);
+            end if;
+
+         when Array_Kind =>
+            if Include_PAT and then Present (Packed_Array_Impl_Type (E)) then
+               return Get_Fullest_View (Packed_Array_Impl_Type (E));
+            end if;
+
+         when E_Record_Subtype =>
+            if Present (Cloned_Subtype (E)) then
+               return Get_Fullest_View (Cloned_Subtype (E), Include_PAT);
+            end if;
+
+         when E_Class_Wide_Type =>
+            return Get_Fullest_View (Root_Type (E), Include_PAT);
+
+         when  E_Class_Wide_Subtype =>
+            if Present (Equivalent_Type (E)) then
+               return Get_Fullest_View (Equivalent_Type (E), Include_PAT);
+            elsif Present (Cloned_Subtype (E)) then
+               return Get_Fullest_View (Cloned_Subtype (E), Include_PAT);
+            end if;
+
+         when E_Protected_Type | E_Protected_Subtype
+            | E_Task_Type |  E_Task_Subtype =>
+            if Present (Corresponding_Record_Type (E)) then
+               return Get_Fullest_View (Corresponding_Record_Type (E),
+                                        Include_PAT);
+            end if;
+
+         when E_Access_Protected_Subprogram_Type
+            | E_Anonymous_Access_Protected_Subprogram_Type =>
+            if Present (Equivalent_Type (E)) then
+               return Get_Fullest_View (Equivalent_Type (E), Include_PAT);
+            end if;
+
+         when E_Access_Subtype =>
+            return Get_Fullest_View (Base_Type (E), Include_PAT);
+
+         when others =>
+            null;
+      end case;
+
+      return E;
+   end Get_Fullest_View;
+
    ------------------------
    -- Get_Generic_Entity --
    ------------------------
diff --git gcc/ada/sem_util.ads gcc/ada/sem_util.ads
index a6bd6e2..e2147e0 100644
--- gcc/ada/sem_util.ads
+++ gcc/ada/sem_util.ads
@@ -1228,6 +1228,12 @@  package Sem_Util is
    --    UFull_Typ - the underlying full view, if the full view is private
    --    CRec_Typ  - the corresponding record type of the full views
 
+   function Get_Fullest_View
+     (E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id;
+   --  Get the fullest possible view of E, looking through private,
+   --  limited, packed array and other implementation types.  If Include_PAT
+   --  is False, don't look inside packed array types.
+
    function Has_Access_Values (T : Entity_Id) return Boolean;
    --  Returns true if type or subtype T is an access type, or has a component
    --  (at any recursive level) that is an access type. This is a conservative