[Ada] Detect unchecked union subcomponents in nested variant parts

gcc/ada/

	* exp_ch4.adb (Has_Unconstrained_UU_Component): Rewrite to
	follow the Ada RM grammar.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e29535e..5093bb1 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8119,130 +8119,124 @@ package body Exp_Ch4 is
       function Has_Unconstrained_UU_Component
         (Typ : Entity_Id) return Boolean
       is
-         Tdef  : constant Node_Id :=
-                   Type_Definition (Declaration_Node (Base_Type (Typ)));
-         Clist : Node_Id;
-         Vpart : Node_Id;
-
-         function Component_Is_Unconstrained_UU
-           (Comp : Node_Id) return Boolean;
-         --  Determines whether the subtype of the component is an
-         --  unconstrained Unchecked_Union.
-
-         function Variant_Is_Unconstrained_UU
-           (Variant : Node_Id) return Boolean;
-         --  Determines whether a component of the variant has an unconstrained
-         --  Unchecked_Union subtype.
-
-         -----------------------------------
-         -- Component_Is_Unconstrained_UU --
-         -----------------------------------
-
-         function Component_Is_Unconstrained_UU
-           (Comp : Node_Id) return Boolean
-         is
-         begin
-            if Nkind (Comp) /= N_Component_Declaration then
-               return False;
-            end if;
+         function Unconstrained_UU_In_Component_Declaration
+           (N : Node_Id) return Boolean;
 
-            declare
-               Sindic : constant Node_Id :=
-                          Subtype_Indication (Component_Definition (Comp));
+         function Unconstrained_UU_In_Component_Items
+           (L : List_Id) return Boolean;
 
-            begin
-               --  Unconstrained nominal type. In the case of a constraint
-               --  present, the node kind would have been N_Subtype_Indication.
+         function Unconstrained_UU_In_Component_List
+           (N : Node_Id) return Boolean;
 
-               if Nkind (Sindic) in N_Expanded_Name | N_Identifier then
-                  return Is_Unchecked_Union (Base_Type (Etype (Sindic)));
-               end if;
-
-               return False;
-            end;
-         end Component_Is_Unconstrained_UU;
+         function Unconstrained_UU_In_Variant_Part
+           (N : Node_Id) return Boolean;
+         --  A family of routines that determine whether a particular construct
+         --  of a record type definition contains a subcomponent of an
+         --  unchecked union type whose nominal subtype is unconstrained.
+         --
+         --  Individual routines correspond to the production rules of the Ada
+         --  grammar, as described in the Ada RM (P).
 
-         ---------------------------------
-         -- Variant_Is_Unconstrained_UU --
-         ---------------------------------
+         -----------------------------------------------
+         -- Unconstrained_UU_In_Component_Declaration --
+         -----------------------------------------------
 
-         function Variant_Is_Unconstrained_UU
-           (Variant : Node_Id) return Boolean
+         function Unconstrained_UU_In_Component_Declaration
+           (N : Node_Id) return Boolean
          is
-            Clist : constant Node_Id := Component_List (Variant);
-            Comp  : Node_Id := First (Component_Items (Clist));
+            pragma Assert (Nkind (N) = N_Component_Declaration);
 
+            Sindic : constant Node_Id :=
+                       Subtype_Indication (Component_Definition (N));
          begin
-            --  We only need to test one component
+            --  Unconstrained nominal type. In the case of a constraint
+            --  present, the node kind would have been N_Subtype_Indication.
+
+            return Nkind (Sindic) in N_Expanded_Name | N_Identifier
+              and then Is_Unchecked_Union (Base_Type (Etype (Sindic)));
+         end Unconstrained_UU_In_Component_Declaration;
+
+         -----------------------------------------
+         -- Unconstrained_UU_In_Component_Items --
+         -----------------------------------------
 
-            while Present (Comp) loop
-               if Component_Is_Unconstrained_UU (Comp) then
+         function Unconstrained_UU_In_Component_Items
+           (L : List_Id) return Boolean
+         is
+            N : Node_Id := First (L);
+         begin
+            while Present (N) loop
+               if Nkind (N) = N_Component_Declaration
+                 and then Unconstrained_UU_In_Component_Declaration (N)
+               then
                   return True;
                end if;
 
-               Next (Comp);
+               Next (N);
             end loop;
 
-            --  None of the components withing the variant were of
-            --  unconstrained Unchecked_Union type.
-
             return False;
-         end Variant_Is_Unconstrained_UU;
+         end Unconstrained_UU_In_Component_Items;
 
-      --  Start of processing for Has_Unconstrained_UU_Component
+         ----------------------------------------
+         -- Unconstrained_UU_In_Component_List --
+         ----------------------------------------
 
-      begin
-         if Null_Present (Tdef) then
-            return False;
-         end if;
-
-         Clist := Component_List (Tdef);
-         Vpart := Variant_Part (Clist);
-
-         --  Inspect available components
-
-         if Present (Component_Items (Clist)) then
-            declare
-               Comp : Node_Id := First (Component_Items (Clist));
+         function Unconstrained_UU_In_Component_List
+           (N : Node_Id) return Boolean
+         is
+            pragma Assert (Nkind (N) = N_Component_List);
 
-            begin
-               while Present (Comp) loop
+            Optional_Variant_Part : Node_Id;
+         begin
+            if Unconstrained_UU_In_Component_Items (Component_Items (N)) then
+               return True;
+            end if;
 
-                  --  One component is sufficient
+            Optional_Variant_Part := Variant_Part (N);
 
-                  if Component_Is_Unconstrained_UU (Comp) then
-                     return True;
-                  end if;
+            return
+              Present (Optional_Variant_Part)
+              and then
+                Unconstrained_UU_In_Variant_Part (Optional_Variant_Part);
+         end Unconstrained_UU_In_Component_List;
 
-                  Next (Comp);
-               end loop;
-            end;
-         end if;
+         --------------------------------------
+         -- Unconstrained_UU_In_Variant_Part --
+         --------------------------------------
 
-         --  Inspect available components withing variants
+         function Unconstrained_UU_In_Variant_Part
+           (N : Node_Id) return Boolean
+         is
+            pragma Assert (Nkind (N) = N_Variant_Part);
 
-         if Present (Vpart) then
-            declare
-               Variant : Node_Id := First (Variants (Vpart));
+            Variant : Node_Id := First (Variants (N));
+         begin
+            loop
+               if Unconstrained_UU_In_Component_List (Component_List (Variant))
+               then
+                  return True;
+               end if;
 
-            begin
-               while Present (Variant) loop
+               Next (Variant);
+               exit when No (Variant);
+            end loop;
 
-                  --  One component within a variant is sufficient
+            return False;
+         end Unconstrained_UU_In_Variant_Part;
 
-                  if Variant_Is_Unconstrained_UU (Variant) then
-                     return True;
-                  end if;
+         Typ_Def : constant Node_Id :=
+           Type_Definition (Declaration_Node (Base_Type (Typ)));
 
-                  Next (Variant);
-               end loop;
-            end;
-         end if;
+         Optional_Component_List : constant Node_Id :=
+           Component_List (Typ_Def);
 
-         --  Neither the available components, nor the components inside the
-         --  variant parts were of an unconstrained Unchecked_Union subtype.
+      --  Start of processing for Has_Unconstrained_UU_Component
 
-         return False;
+      begin
+         return Present (Optional_Component_List)
+           and then
+             Unconstrained_UU_In_Component_List (Optional_Component_List);
       end Has_Unconstrained_UU_Component;
 
       --  Local variables