[Ada] Crash on Loop_Entry for while_loop involving substrings

When expanding a loop entry attribute for a while_loop we construct a
function that incorporates the expanded condition of the loop. The
itypes that may be generated in that expansion must carry the scope of
the constructed function for proper handling in the backend.

2019-08-20  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_attr.adb (Expand_Loop_Entry_Attribute): When expanding a
	loop entry attribute for a while_loop we construct a function
	that incorporates the expanded condition of the loop. The itypes
	that may be generated in that expansion must carry the scope of
	the constructed function for proper handling in gigi.

gcc/testsuite/

	* gnat.dg/loop_entry2.adb: New testcase.

From-SVN: r274734

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc32ef89eaf947859d03399cc21ceb6e6fa341ad..238df0fe174bd2ae2a96935477c61b3d949448a2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-08-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_attr.adb (Expand_Loop_Entry_Attribute): When expanding a
+       loop entry attribute for a while_loop we construct a function
+       that incorporates the expanded condition of the loop. The itypes
+       that may be generated in that expansion must carry the scope of
+       the constructed function for proper handling in gigi.
+
 2019-08-20  Ed Schonberg  <schonberg@adacore.com>
 
        * exp_disp.adb (Build_Class_Wide_Check, Replace_Formals): When a

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 306c1b56404f44903a4a19502d8ad6e80ba137c3..c7d1647b42e554bd8b8b23f948f2b7c201af659a 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1436,6 +1436,25 @@ package body Exp_Attr is
                Insert_Action (Loop_Stmt, Func_Decl);
                Pop_Scope;
 
+               --  The analysis of the condition may have generated itypes
+               --  that are now used within the function: Adjust their
+               --  scopes accordingly so that their use appears in their
+               --  scope of definition.
+
+               declare
+                  Ityp : Entity_Id;
+
+               begin
+                  Ityp := First_Entity (Loop_Id);
+
+                  while Present (Ityp) loop
+                     if Is_Itype (Ityp) then
+                        Set_Scope (Ityp, Func_Id);
+                     end if;
+                     Next_Entity (Ityp);
+                  end loop;
+               end;
+
                --  Transform the original while loop into an infinite loop
                --  where the last statement checks the negated condition. This
                --  placement ensures that the condition will not be evaluated

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 629041b6f7fbe1765ff89d2f2533aa22f398ea87..b330c78955a99416401926dc724787a530cdb193 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/loop_entry2.adb: New testcase.
+
 2019-08-20  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/tagged5.adb, gnat.dg/tagged5.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/loop_entry2.adb b/gcc/testsuite/gnat.dg/loop_entry2.adb
new file mode 100644 (file)
index 0000000..1708e73
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/loop_entry2.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+--  { dg-options "-gnata" }
+
+procedure Loop_Entry2 (S : String) is
+   J : Integer := S'First;
+begin
+   while S(J..J+1) = S(J..J+1) loop
+      pragma Loop_Invariant (for all K in J'Loop_Entry .. J => K <= J);
+      J := J + 1;
+   end loop;
+end;