[Ada] Implementation of Ada 2012 AI05-0026: Missing rules for Unchecked_Union
Arnaud Charlet
charlet@adacore.com
Thu Oct 7 09:27:00 GMT 2010
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.
-------------- next part --------------
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
More information about the Gcc-patches
mailing list