Commit b6b011dd by Ed Schonberg Committed by Pierre-Marie de Rodat

[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
parent 1233757a
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
dispatching call tp a subprogram with a class-wide precondition
occurrs in the same declarative part as the ancestor subprogram
......
......@@ -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
......
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.
2019-08-20 Gary Dismukes <dismukes@adacore.com>
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment