[Ada] Fix internal error on array slice in loop and Loop_Invariant

[Ada] Fix internal error on array slice in loop and Loop_Invariant

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 627 bytes --]

This fixes an internal error caused by the presence of an Itype in a
wrong scope.  This Itype is created for an array slice present in the
condition of a while loop whose body also contains a pragma
Loop_Invariant, initially in the correct scope but then relocated into a
function created for the pragma.

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

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Copy the condition
	of a while loop instead of simply relocating it.

gcc/testsuite/

	* gnat.dg/loop_invariant1.adb, gnat.dg/loop_invariant1.ads: New
	testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1890 bytes --]

--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -1384,6 +1384,8 @@ package body Exp_Attr is
                Stmts     : List_Id;
 
             begin
+               Func_Id := Make_Temporary (Loc, 'F');
+
                --  Wrap the condition of the while loop in a Boolean function.
                --  This avoids the duplication of the same code which may lead
                --  to gigi issues with respect to multiple declaration of the
@@ -1403,7 +1405,9 @@ package body Exp_Attr is
 
                Append_To (Stmts,
                  Make_Simple_Return_Statement (Loc,
-                   Expression => Relocate_Node (Condition (Scheme))));
+                   Expression =>
+                     New_Copy_Tree (Condition (Scheme),
+                       New_Scope => Func_Id)));
 
                --  Generate:
                --    function Fnn return Boolean is
@@ -1411,7 +1415,6 @@ package body Exp_Attr is
                --       <Stmts>
                --    end Fnn;
 
-               Func_Id   := Make_Temporary (Loc, 'F');
                Func_Decl :=
                  Make_Subprogram_Body (Loc,
                    Specification              =>

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/loop_invariant1.adb
@@ -0,0 +1,15 @@
+--  { dg-do compile }
+--  { dg-options "-gnata" }
+
+package body Loop_Invariant1 is
+
+   procedure Proc (A : Arr; N : Integer) is
+      I : Integer := A'First;
+   begin
+      while i <= A'Last and then A(A'First .. A'Last) /= A loop
+         pragma Loop_Invariant (N = N'Loop_Entry);
+         i := i + 1;
+      end loop;
+   end;
+
+end Loop_Invariant1;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/loop_invariant1.ads
@@ -0,0 +1,7 @@
+package Loop_Invariant1 is
+
+   type Arr is array (Natural range <>) of Integer;
+
+   procedure Proc (A : Arr; N : Integer);
+
+end Loop_Invariant1;