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

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.

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.

From-SVN: r273668

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ff3582f6837808f05f1cd844a04aaa816b3180cd..38cc4b833a07d8336c684460b778690570f8d011 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_attr.adb (Expand_Loop_Entry_Attribute): Copy the condition
+       of a while loop instead of simply relocating it.
+
 2019-07-18  Arnaud Charlet  <charlet@adacore.com>
 
        * Makefile.rtl, expect.c, env.c, aux-io.c, mkdir.c, initialize.c,

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index ac99ec1346906d3806560bf4659a076ae9932d21..90ca8ffbd8d978ab61d59c5c78444c2bb4df857e 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/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              =>

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e0637748eb8a3846438df595793b86b57ed9838c..e9c2b5e3b7dbf3a9b2b5cdfad2416d11ae243057 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/loop_invariant1.adb, gnat.dg/loop_invariant1.ads: New
+       testcase.
+
 2019-07-22  Richard Biener  <rguenther@suse.de>
 
        PR tree-optimization/91221

diff --git a/gcc/testsuite/gnat.dg/loop_invariant1.adb b/gcc/testsuite/gnat.dg/loop_invariant1.adb
new file mode 100644 (file)
index 0000000..a5c9476
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/loop_invariant1.ads b/gcc/testsuite/gnat.dg/loop_invariant1.ads
new file mode 100644 (file)
index 0000000..5c19a92
--- /dev/null
+++ b/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;