From 326776548e5959daf62f8583ee2356f2352452fc Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 23 May 2018 10:21:53 +0000 Subject: [PATCH] [Ada] Build-in-place aggregates and Address clauses This patch fixes a bug in which if a limited volatile variable with an Address aspect is initialized with a build-in-place aggregate containing build-in-place function calls, the compiler can crash. 2018-05-23 Bob Duff gcc/ada/ * freeze.adb: (Check_Address_Clause): Deal with build-in-place aggregates in addition to build-in-place calls. gcc/testsuite/ * gnat.dg/addr10.adb: New testcase. From-SVN: r260574 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/freeze.adb | 13 ++++++------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/addr10.adb | 24 ++++++++++++++++++++++++ 4 files changed, 39 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/addr10.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 98720a392a2..f9ad15908a6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-05-23 Bob Duff + + * freeze.adb: (Check_Address_Clause): Deal with build-in-place + aggregates in addition to build-in-place calls. + 2018-05-23 Bob Duff * einfo.ads: Minor reformatting. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 66f9dcca62c..032dcf516f8 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -710,13 +710,12 @@ package body Freeze is end; end if; - -- Remove side effects from initial expression, except in the case - -- of a build-in-place call, which has its own later expansion. + -- Remove side effects from initial expression, except in the case of + -- limited build-in-place calls and aggregates, which have their own + -- expansion elsewhere. This exception is necessary to avoid copying + -- limited objects. - if Present (Init) - and then (Nkind (Init) /= N_Function_Call - or else not Is_Expanded_Build_In_Place_Call (Init)) - then + if Present (Init) and then not Is_Limited_View (Typ) then -- Capture initialization value at point of declaration, and make -- explicit assignment legal, because object may be a constant. @@ -735,7 +734,7 @@ package body Freeze is Set_No_Initialization (Decl); - -- If the objet is tagged, check whether the tag must be + -- If the object is tagged, check whether the tag must be -- reassigned explicitly. Tag_Assign := Make_Tag_Assignment (Decl); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5a80e1d1a5c..b12fb9e2d36 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-23 Bob Duff + + * gnat.dg/addr10.adb: New testcase. + 2018-05-23 Richard Biener PR middle-end/85874 diff --git a/gcc/testsuite/gnat.dg/addr10.adb b/gcc/testsuite/gnat.dg/addr10.adb new file mode 100644 index 00000000000..16efa28ed6b --- /dev/null +++ b/gcc/testsuite/gnat.dg/addr10.adb @@ -0,0 +1,24 @@ +-- { dg-do compile } + +with System; + +procedure Addr10 is + type Limited_Type is limited record + Element : Integer; + end record; + + function Initial_State return Limited_Type is ((Element => 0)); + + type Double_Limited_Type is + record + A : Limited_Type; + end record; + + Double_Limited : Double_Limited_Type := + (A => Initial_State) + with + Volatile, + Address => System'To_Address (16#1234_5678#); +begin + null; +end Addr10; -- 2.30.2