From patchwork Thu Oct 7 09:27:00 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Ada] Implementation of Ada 2012 AI05-0026: Missing rules for Unchecked_Union From: Arnaud Charlet X-Patchwork-Id: 67021 Message-Id: <20101007092700.GA31414@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Date: Thu, 7 Oct 2010 11:27:00 +0200 This patch integrates the new semantic rules as defined in AI05-0026 version 1.6 concerning Unchecked_Union types. The following test program illustrates the major points of the AI. procedure Main is begin declare type UU (Discr : Boolean := False) is record Comp1 : Integer; case Discr is when True => Comp2 : Float; when others => Comp3 : Integer; end case; end record; pragma Unchecked_Union (UU); for UU use record Discr at 0 range 0 .. 8; -- ERROR end record; begin null; end; declare type Root is tagged null record; generic type Priv_Formal_Typ is private; type Priv_Formal_Ext is new Root with private; package Solitary_Gen is type Spec_UU (Discr : Boolean := False) is record Comp1 : Priv_Formal_Typ; -- OK case Discr is when True => Comp2 : Priv_Formal_Typ; -- OK when False => Comp3 : Priv_Formal_Ext; -- OK end case; end record; pragma Unchecked_Union (Spec_UU); procedure Dummy; end Solitary_Gen; package body Solitary_Gen is type Body_UU (Discr : Boolean := False) is record Comp1 : Priv_Formal_Typ; -- OK case Discr is when True => Comp2 : Priv_Formal_Typ; -- ERROR when False => Comp3 : Priv_Formal_Ext; -- ERROR end case; end record; pragma Unchecked_Union (Body_UU); procedure Dummy is begin null; end Dummy; end Solitary_Gen; begin null; end; end Main; ----------------- -- Compilation -- ----------------- gnatmake -gnat12 main.adb --------------------- -- Expected output -- --------------------- main.adb:16:10: cannot reference discriminant of Unchecked_Union main.adb:47:19: component of Unchecked_Union cannot be of generic type main.adb:49:19: component of Unchecked_Union cannot be of generic type Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-07 Hristian Kirtchev * sem_ch13.adb (Analyze_Record_Representation_Clause): Alphabetize all local variables. Remove the general restriction which prohibits the application of record rep clauses to Unchecked_Union types. Add Ada 2012 check to detect improper naming of an Unchecked_Union discriminant in record rep clause. * sem_prag.adb: Add with and use clause for Exp_Ch7. (Analyze_Pragma): Unchecked_Union case: Propagate the Unchecked_Union type to all invocations of Check_Component and Check_Variant. (Check_Component): Add formal parameters UU_Typ and In_Variant_Part. Rewritten. Add Ada 2012 check to detect improper use of formal private types and private extensions as component types of an Unchecked_Union declared inside a generic body. (Check_Variant): Add formal parameter UU_Typ. Propagate the Unchecked_Union type to all calls of Check_Component. Signal that the current component comes from the variant part of an Unchecked_Union type. (Inside_Generic_Body): New routine. Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 165082) +++ sem_prag.adb (working copy) @@ -37,6 +37,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; +with Exp_Ch7; use Exp_Ch7; with Exp_Dist; use Exp_Dist; with Lib; use Lib; with Lib.Writ; use Lib.Writ; @@ -392,9 +393,14 @@ package body Sem_Prag is procedure Check_At_Most_N_Arguments (N : Nat); -- Check there are no more than N arguments present - procedure Check_Component (Comp : Node_Id); - -- Examine Unchecked_Union component for correct use of per-object + procedure Check_Component + (Comp : Node_Id; + UU_Typ : Entity_Id; + In_Variant_Part : Boolean := False); + -- Examine an Unchecked_Union component for correct use of per-object -- constrained subtypes, and for restrictions on finalizable components. + -- UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part + -- should be set when Comp comes from a record variant. procedure Check_Duplicated_Export_Name (Nam : Node_Id); -- Nam is an N_String_Literal node containing the external name set by @@ -483,9 +489,10 @@ package body Sem_Prag is -- and to library level instantiations), and they are simply ignored, -- which is implemented by rewriting them as null statements. - procedure Check_Variant (Variant : Node_Id); - -- Check Unchecked_Union variant for lack of nested variants and - -- presence of at least one component. + procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id); + -- Check an Unchecked_Union variant for lack of nested variants and + -- presence of at least one component. UU_Typ is the related Unchecked_ + -- Union type. procedure Error_Pragma (Msg : String); pragma No_Return (Error_Pragma); @@ -1094,39 +1101,80 @@ package body Sem_Prag is -- Check_Component -- --------------------- - procedure Check_Component (Comp : Node_Id) is - begin - if Nkind (Comp) = N_Component_Declaration then - declare - Sindic : constant Node_Id := - Subtype_Indication (Component_Definition (Comp)); - Typ : constant Entity_Id := - Etype (Defining_Identifier (Comp)); - begin - if Nkind (Sindic) = N_Subtype_Indication then + procedure Check_Component + (Comp : Node_Id; + UU_Typ : Entity_Id; + In_Variant_Part : Boolean := False) + is + Comp_Id : constant Entity_Id := Defining_Identifier (Comp); + Sindic : constant Node_Id := + Subtype_Indication (Component_Definition (Comp)); + Typ : constant Entity_Id := Etype (Comp_Id); - -- Ada 2005 (AI-216): If a component subtype is subject to - -- a per-object constraint, then the component type shall - -- be an Unchecked_Union. + function Inside_Generic_Body (Id : Entity_Id) return Boolean; + -- Determine whether entity Id appears inside a generic body - if Has_Per_Object_Constraint (Defining_Identifier (Comp)) - and then - not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic))) - then - Error_Msg_N ("component subtype subject to per-object" & - " constraint must be an Unchecked_Union", Comp); - end if; - end if; + ------------------------- + -- Inside_Generic_Body -- + ------------------------- - if Is_Controlled (Typ) then - Error_Msg_N - ("component of unchecked union cannot be controlled", Comp); + function Inside_Generic_Body (Id : Entity_Id) return Boolean is + S : Entity_Id := Id; - elsif Has_Task (Typ) then - Error_Msg_N - ("component of unchecked union cannot have tasks", Comp); + begin + while Present (S) + and then S /= Standard_Standard + loop + if Ekind (S) = E_Generic_Package + and then In_Package_Body (S) + then + return True; end if; - end; + + S := Scope (S); + end loop; + + return False; + end Inside_Generic_Body; + + -- Start of processing for Check_Component + + begin + -- Ada 2005 (AI-216): If a component subtype is subject to a per- + -- object constraint, then the component type shall be an Unchecked_ + -- Union. + + if Nkind (Sindic) = N_Subtype_Indication + and then Has_Per_Object_Constraint (Comp_Id) + and then not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic))) + then + Error_Msg_N + ("component subtype subject to per-object constraint " & + "must be an Unchecked_Union", Comp); + + -- Ada 2012 (AI05-0026): For an unchecked union type declared within + -- the body of a generic unit, or within the body of any of its + -- descendant library units, no part of the type of a component + -- declared in a variant_part of the unchecked union type shall be of + -- a formal private type or formal private extension declared within + -- the formal part of the generic unit. + + elsif Ada_Version >= Ada_2012 + and then Inside_Generic_Body (UU_Typ) + and then In_Variant_Part + and then Is_Private_Type (Typ) + and then Is_Generic_Type (Typ) + then + Error_Msg_N + ("component of Unchecked_Union cannot be of generic type", Comp); + + elsif Needs_Finalization (Typ) then + Error_Msg_N + ("component of Unchecked_Union cannot be controlled", Comp); + + elsif Has_Task (Typ) then + Error_Msg_N + ("component of Unchecked_Union cannot have tasks", Comp); end if; end Check_Component; @@ -1698,7 +1746,7 @@ package body Sem_Prag is -- Check_Variant -- ------------------- - procedure Check_Variant (Variant : Node_Id) is + procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id) is Clist : constant Node_Id := Component_List (Variant); Comp : Node_Id; @@ -1712,7 +1760,7 @@ package body Sem_Prag is Comp := First (Component_Items (Clist)); while Present (Comp) loop - Check_Component (Comp); + Check_Component (Comp, UU_Typ, In_Variant_Part => True); Next (Comp); end loop; end Check_Variant; @@ -11971,7 +12019,7 @@ package body Sem_Prag is Comp := First (Component_Items (Clist)); while Present (Comp) loop - Check_Component (Comp); + Check_Component (Comp, Typ); Next (Comp); end loop; @@ -11986,7 +12034,7 @@ package body Sem_Prag is Variant := First (Variants (Vpart)); while Present (Variant) loop - Check_Variant (Variant); + Check_Variant (Variant, Typ); Next (Variant); end loop; end if; Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 165080) +++ sem_ch13.adb (working copy) @@ -2506,16 +2506,16 @@ package body Sem_Ch13 is -- for the remainder of this processing. procedure Analyze_Record_Representation_Clause (N : Node_Id) is - Ident : constant Node_Id := Identifier (N); - Rectype : Entity_Id; + Ident : constant Node_Id := Identifier (N); + Biased : Boolean; CC : Node_Id; - Posit : Uint; + Comp : Entity_Id; Fbit : Uint; - Lbit : Uint; Hbit : Uint := Uint_0; - Comp : Entity_Id; + Lbit : Uint; Ocomp : Entity_Id; - Biased : Boolean; + Posit : Uint; + Rectype : Entity_Id; CR_Pragma : Node_Id := Empty; -- Points to N_Pragma node if Complete_Representation pragma present @@ -2543,10 +2543,6 @@ package body Sem_Ch13 is ("record type required, found}", Ident, First_Subtype (Rectype)); return; - elsif Is_Unchecked_Union (Rectype) then - Error_Msg_N - ("record rep clause not allowed for Unchecked_Union", N); - elsif Scope (Rectype) /= Current_Scope then Error_Msg_N ("type must be declared in this scope", N); return; @@ -2722,6 +2718,24 @@ package body Sem_Ch13 is Error_Msg_N ("component clause is for non-existent field", CC); + -- Ada 2012 (AI05-0026): Any name that denotes a + -- discriminant of an object of an unchecked union type + -- shall not occur within a record_representation_clause. + + -- The general restriction of using record rep clauses on + -- Unchecked_Union types has now been lifted. Since it is + -- possible to introduce a record rep clause which mentions + -- the discriminant of an Unchecked_Union in non-Ada 2012 + -- code, this check is applied to all versions of the + -- language. + + elsif Ekind (Comp) = E_Discriminant + and then Is_Unchecked_Union (Rectype) + then + Error_Msg_N + ("cannot reference discriminant of Unchecked_Union", + Component_Name (CC)); + elsif Present (Component_Clause (Comp)) then -- Diagnose duplicate rep clause, or check consistency