[Ada] Implement AI12-0162 Memberships and Unchecked_Unions
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 10 Mar 2020 08:09:25 +0000 (09:09 +0100)
committerPierre-Marie de Rodat <derodat@adacore.com>
Wed, 10 Jun 2020 13:35:01 +0000 (09:35 -0400)
2020-06-10  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

* exp_ch4.adb (Expand_N_In): Use an expression with actions to
insert the PE raise statement for the Unchecked_Union case.

gcc/ada/exp_ch4.adb

index cd1093521e5d2b737a249cba05eec8a1e5f3a56d..d416c06a8fe8965b4c6baa781a1d55562c5c2d4e 100644 (file)
@@ -6527,23 +6527,24 @@ package body Exp_Ch4 is
 
                goto Leave;
 
-            --  Ada 2005 (AI-216): Program_Error is raised when evaluating
-            --  a membership test if the subtype mark denotes a constrained
-            --  Unchecked_Union subtype and the expression lacks inferable
-            --  discriminants.
+            --  Ada 2005 (AI95-0216 amended by AI12-0162): Program_Error is
+            --  raised when evaluating an individual membership test if the
+            --  subtype mark denotes a constrained Unchecked_Union subtype
+            --  and the expression lacks inferable discriminants.
 
             elsif Is_Unchecked_Union (Base_Type (Typ))
               and then Is_Constrained (Typ)
               and then not Has_Inferable_Discriminants (Lop)
             then
-               Insert_Action (N,
-                 Make_Raise_Program_Error (Loc,
-                   Reason => PE_Unchecked_Union_Restriction));
-
-               --  Prevent Gigi from generating incorrect code by rewriting the
-               --  test as False. What is this undocumented thing about ???
+               Rewrite (N,
+                 Make_Expression_With_Actions (Loc,
+                   Actions    =>
+                     New_List (Make_Raise_Program_Error (Loc,
+                       Reason => PE_Unchecked_Union_Restriction)),
+                   Expression =>
+                     New_Occurrence_Of (Standard_False, Loc)));
+               Analyze_And_Resolve (N, Restyp);
 
-               Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
                goto Leave;
             end if;