This patch fixes a spurious error on a renaming of a conversion of the
designated object of a pointer to class-wide type when the target type has
an invariant aspect.

The following must execute quietly:

   gnatmake -gnata -q main

with System.Assertions; use System.Assertions;
with Gd; use Gd;
procedure main is
   raise Program_Error;
   when Assert_Failure => null;
package CN is
   type CN_Type is private;
   type CN_Type is record
      V : Integer := 27;   -- wrong initialization
   end record  with Type_Invariant => V mod 7 = 0;
package HD is
   type HD_Type is tagged null record;
   type HD_Class_Pointer is access HD_Type'Class;
with CN;
with HD;
package GD is
   type XT is new HD.HD_Type with record
      X : aliased CN.CN_Type;
   end record;
   procedure Foo;
package body GD is
   procedure Foo is
      DHP : constant HD.HD_Class_Pointer := new XT;
      DH  : XT renames XT (DHP.all);

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

2016-10-12  Ed Schonberg  <>

        * exp_ch4.adb (Expand_N_Type_Conversion): If the target type
        has an invariant aspect, insert invariant call at the proper
        place in the code rather than rewriting the expression as an
        expression with actions, to prevent spurious semantic errors on
        the rewritten conversion when it is the object in a renaming.

Index: exp_ch4.adb
--- exp_ch4.adb (revision 241041)
+++ exp_ch4.adb (working copy)
@@ -10577,16 +10577,17 @@
       end if;
       --  Check for case of converting to a type that has an invariant
-      --  associated with it. This required an invariant check. We convert
+      --  associated with it. This requires an invariant check. We insert
+      --  a call:
-      --    typ (expr)
+      --        invariant_check (typ (expr))
-      --  into
+      --  in the code, after removing side effects from the expression.
+      --  This is clearer than replacing the conversion into an expression
+      --  with actions, because the context may impose additional actions
+      --  (tag checks, membership tests, etc.) that conflict with this
+      --  rewriting (used previously).
-      --    do invariant_check (typ (expr)) in typ (expr);
-      --  using Duplicate_Subexpr to avoid multiple side effects
       --  Note: the Comes_From_Source check, and then the resetting of this
       --  flag prevents what would otherwise be an infinite recursion.
@@ -10595,12 +10596,8 @@
         and then Comes_From_Source (N)
          Set_Comes_From_Source (N, False);
-         Rewrite (N,
-           Make_Expression_With_Actions (Loc,
-             Actions    => New_List (
-               Make_Invariant_Call (Duplicate_Subexpr (N))),
-             Expression => Duplicate_Subexpr_No_Checks (N)));
-         Analyze_And_Resolve (N, Target_Type);
+         Remove_Side_Effects (N);
+         Insert_Action (N, Make_Invariant_Call (Duplicate_Subexpr (N)));
          goto Done;
       end if;

Reply via email to