From b6b011dd38da56a04dbf7d27833d015f2789a6f5 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 20 Aug 2019 09:50:00 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/exp_attr.adb | 19 +++++++++++++++++++ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/loop_entry2.adb | 11 +++++++++++ 4 files changed, 42 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/loop_entry2.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc32ef8..238df0f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,13 @@ 2019-08-20 Ed Schonberg + * 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 + * 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 diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 306c1b5..c7d1647 100644 --- 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 629041b..b330c78 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2019-08-20 Ed Schonberg + * gnat.dg/loop_entry2.adb: New testcase. + +2019-08-20 Ed Schonberg + * gnat.dg/tagged5.adb, gnat.dg/tagged5.ads: New testcase. 2019-08-20 Gary Dismukes diff --git a/gcc/testsuite/gnat.dg/loop_entry2.adb b/gcc/testsuite/gnat.dg/loop_entry2.adb new file mode 100644 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; -- 2.7.4