diff mbox series

[Ada] Crash on Loop_Entry for while_loop involving substrings

Message ID 20190820095127.GA75554@adacore.com
State New
Headers show
Series [Ada] Crash on Loop_Entry for while_loop involving substrings | expand

Commit Message

Pierre-Marie de Rodat Aug. 20, 2019, 9:51 a.m. UTC 
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.

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

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

Patch

--- gcc/ada/exp_attr.adb
+++ 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

--- /dev/null
new file mode 100644
+++ 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;