diff mbox

[Ada] Spurious error on renaming of type conversion with invariant.

Message ID 20161012135536.GA65033@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 12, 2016, 1:55 p.m. UTC
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
   main

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

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

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* 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.
diff mbox

Patch

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)
       then
          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;