From: Piotr Trojanek Date: Wed, 13 Jan 2021 16:17:34 +0000 (+0100) Subject: [Ada] Detect unchecked union subcomponents in nested variant parts X-Git-Tag: basepoints/gcc-13~7809 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e02f9af5b2a953badf9b8f97dcb3b150f9ed3965;p=thirdparty%2Fgcc.git [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 e29535ec7028..5093bb156d2d 100644 --- 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