Patchwork [Ada] Legality rules for pragma Unchecked_Union

login
register
mail settings
Submitter Arnaud Charlet
Date Nov. 6, 2012, 10:11 a.m.
Message ID <20121106101139.GA16288@adacore.com>
Download mbox | patch
Permalink /patch/197440/
State New
Headers show

Comments

Arnaud Charlet - Nov. 6, 2012, 10:11 a.m.
GNAT implemented this pragma before it was part of the standard, and a left-
over of this early implementation is the requirement that discriminants of
an unchecked_union type all must have defaults.  This is not a legality rule
imposed by the Ada RM,  and this patch removes it.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-11-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove
	requirement that discriminants of an unchecked_union must have
	defaults.  Uncovered by discussion on LA12-042.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 193217)
+++ sem_prag.adb	(working copy)
@@ -14495,7 +14495,6 @@ 
             Assoc   : constant Node_Id := Arg1;
             Type_Id : constant Node_Id := Get_Pragma_Arg (Assoc);
             Typ     : Entity_Id;
-            Discr   : Entity_Id;
             Tdef    : Node_Id;
             Clist   : Node_Id;
             Vpart   : Node_Id;
@@ -14546,21 +14545,12 @@ 
             --  Note: in previous versions of GNAT we used to check for limited
             --  types and give an error, but in fact the standard does allow
             --  Unchecked_Union on limited types, so this check was removed.
+            --  Similarly, GNAT used to require that all discriminants have
+            --  default values, but this is not mandated by the RM.
 
             --  Proceed with basic error checks completed
 
             else
-               Discr := First_Discriminant (Typ);
-               while Present (Discr) loop
-                  if No (Discriminant_Default_Value (Discr)) then
-                     Error_Msg_N
-                       ("unchecked union discriminant must have default value",
-                        Discr);
-                  end if;
-
-                  Next_Discriminant (Discr);
-               end loop;
-
                Tdef  := Type_Definition (Declaration_Node (Typ));
                Clist := Component_List (Tdef);