diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 18 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/aggr28.adb | 29 |
4 files changed, 53 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 384f982..5c17f81 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-09-18 Eric Botcazou <ebotcazou@adacore.com> + + * exp_aggr.adb (Build_Array_Aggr_Code): In STEP 1 (c), duplicate + the expression and reset the Loop_Actions for each loop + generated for an others choice. + 2019-09-18 Justin Squirek <squirek@adacore.com> * einfo.adb, einfo.ads (Minimum_Accessibility): Added new field. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7f11b41..5b2e0a5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2075,7 +2075,6 @@ package body Exp_Aggr is Choice := First (Choice_List (Assoc)); while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then - Set_Loop_Actions (Assoc, New_List); Others_Assoc := Assoc; exit; end if; @@ -2122,7 +2121,8 @@ package body Exp_Aggr is if Present (Others_Assoc) then declare - First : Boolean := True; + First : Boolean := True; + Dup_Expr : Node_Id; begin for J in 0 .. Nb_Choices loop @@ -2160,9 +2160,19 @@ package body Exp_Aggr is or else not Empty_Range (Low, High) then First := False; + + -- Duplicate the expression in case we will be generating + -- several loops. As a result the expression is no longer + -- shared between the loops and is reevaluated for each + -- such loop. + + Expr := Get_Assoc_Expr (Others_Assoc); + Dup_Expr := New_Copy_Tree (Expr); + Set_Parent (Dup_Expr, Parent (Expr)); + + Set_Loop_Actions (Others_Assoc, New_List); Append_List - (Gen_Loop (Low, High, - Get_Assoc_Expr (Others_Assoc)), To => New_Code); + (Gen_Loop (Low, High, Dup_Expr), To => New_Code); end if; end loop; end; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fd0efb1..32297d1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-18 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/aggr28.adb: New testcase. + 2019-09-18 Steve Baird <baird@adacore.com> * gnat.dg/ai12_0086_example.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/aggr28.adb b/gcc/testsuite/gnat.dg/aggr28.adb new file mode 100644 index 0000000..3375b71 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr28.adb @@ -0,0 +1,29 @@ +-- { dg-do run } + +procedure Aggr28 is + + Count : Natural := 0; + + function Get (S: String) return String is + begin + Count := Count + 1; + return S; + end; + + Max_Error_Length : constant := 8; + subtype Error_Type is String (1 .. Max_Error_Length); + + type Rec is record + Text : Error_Type; + end record; + + type Arr is array (1 .. 16) of Rec; + + Table : constant Arr := + (3 => (Text => Get ("INVALID ")), others => (Text => Get ("OTHERS "))); + +begin + if Count /= Table'Length then + raise Program_Error; + end if; +end;
\ No newline at end of file |