===================================================================
@@ -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;
===================================================================
@@ -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
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 <kirtchev@adacore.com> * 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.