From a2dbe7d5ae0627efc7079ff59f39487b78a2423d Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 11 Jan 2018 08:56:12 +0000 Subject: [PATCH] [Ada] Crash on build-in-place call with address specification for target The presence of an address clause complicates the build-in-place expansion because the indicated address must be processed before the indirect call is generated, including the definition of a local pointer to the object. The address clause may come from an aspect specification or from an explicit attribute specification appearing after the object declaration. These two cases require different processing. 2018-01-11 Ed Schonberg gcc/ada/ * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Handle properly object declarations with initializations that are build-in-place function calls, when there is an address specification, either as an aspect specification or an explicit attribute specification clause, for the initialized object. * freeze.adb (Check_Address_Clause): Do not remove side-effects from initial expressions in the case of a build-in-place call. gcc/testsuite/ * gnat.dg/bip_overlay.adb, gnat.dg/bip_overlay.ads: New testcase. From-SVN: r256523 --- gcc/ada/ChangeLog | 10 +++++ gcc/ada/exp_ch6.adb | 62 ++++++++++++++++++++++++++- gcc/ada/freeze.adb | 13 ++++-- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/bip_overlay.adb | 23 ++++++++++ gcc/testsuite/gnat.dg/bip_overlay.ads | 22 ++++++++++ 6 files changed, 129 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/bip_overlay.adb create mode 100644 gcc/testsuite/gnat.dg/bip_overlay.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7b26e37791f..63c2a9500a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-01-11 Ed Schonberg + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Handle + properly object declarations with initializations that are + build-in-place function calls, when there is an address specification, + either as an aspect specification or an explicit attribute + specification clause, for the initialized object. + * freeze.adb (Check_Address_Clause): Do not remove side-effects from + initial expressions in the case of a build-in-place call. + 2018-01-11 Piotr Trojanek * sem_eval.adb (Is_Null_Range): Retrieve the full view when called on a diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e52fb8c398b..c9d40433efd 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Aspects; use Aspects; with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; @@ -8418,7 +8419,66 @@ package body Exp_Ch6 is -- freezing. if Definite and then not Is_Return_Object (Obj_Def_Id) then - Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl); + + -- The presence of an address clause complicates the build-in-place + -- expansion because the indicated address must be processed before + -- the indirect call is generated (including the definition of a + -- local pointer to the object). The address clause may come from + -- an aspect specification or from an explicit attribute + -- specification appearing after the object declaration. These two + -- cases require different processing. + + if Has_Aspect (Obj_Def_Id, Aspect_Address) then + + -- Skip non-delayed pragmas that correspond to other aspects, if + -- any, to find proper insertion point for freeze node of object. + + declare + D : Node_Id := Obj_Decl; + N : Node_Id := Next (D); + + begin + while Present (N) + and then Nkind_In (N, N_Pragma, N_Attribute_Reference) + loop + Analyze (N); + D := N; + Next (N); + end loop; + + Insert_After (D, Ptr_Typ_Decl); + + -- Freeze object before pointer declaration, to ensure that + -- generated attribute for address is inserted at the proper + -- place. + + Freeze_Before (Ptr_Typ_Decl, Obj_Def_Id); + end; + + Analyze (Ptr_Typ_Decl); + + elsif Present (Following_Address_Clause (Obj_Decl)) then + + -- Locate explicit address clause, which may also follow pragmas + -- generated by other aspect specifications. + + declare + Addr : constant Node_Id := Following_Address_Clause (Obj_Decl); + D : Node_Id := Next (Obj_Decl); + + begin + while Present (D) loop + Analyze (D); + exit when D = Addr; + Next (D); + end loop; + + Insert_After_And_Analyze (Addr, Ptr_Typ_Decl); + end; + + else + Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl); + end if; else Insert_Action (Obj_Decl, Ptr_Typ_Decl); end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1e6e2575fef..08163ef9062 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -711,11 +711,16 @@ package body Freeze is end; end if; - if Present (Init) then + -- Remove side effects from initial expression, except in the case + -- of a build-in-place call, which has its own later expansion. - -- Capture initialization value at point of declaration, - -- and make explicit assignment legal, because object may - -- be a constant. + if Present (Init) + and then (Nkind (Init) /= N_Function_Call + or else not Is_Expanded_Build_In_Place_Call (Init)) + then + + -- Capture initialization value at point of declaration, and make + -- explicit assignment legal, because object may be a constant. Remove_Side_Effects (Init); Lhs := New_Occurrence_Of (E, Sloc (Decl)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 43dcbedcad3..e6d2045674a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-01-11 Ed Schonberg + + * gnat.dg/bip_overlay.adb, gnat.dg/bip_overlay.ads: New testcase. + 2018-01-11 Hristian Kirtchev * gnat.dg/protected_func.adb, gnat.dg/protected_func.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/bip_overlay.adb b/gcc/testsuite/gnat.dg/bip_overlay.adb new file mode 100644 index 00000000000..c4a38499bc2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_overlay.adb @@ -0,0 +1,23 @@ +-- { dg-do compile } + +with System; + +package body BIP_Overlay +with + SPARK_Mode +is + function Init return X + is + begin + return Result : X do + Result.E := 0; + end return; + end Init; + + I : X := Init + with + Volatile, + Async_Readers, + Address => System'To_Address (16#1234_5678#); + +end BIP_Overlay; diff --git a/gcc/testsuite/gnat.dg/bip_overlay.ads b/gcc/testsuite/gnat.dg/bip_overlay.ads new file mode 100644 index 00000000000..9a564ff0865 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_overlay.ads @@ -0,0 +1,22 @@ +package BIP_Overlay + with SPARK_Mode +is + type X (<>) is limited private; + + pragma Warnings (gnatprove, Off, + "volatile function ""Init"" has no volatile effects", + reason => "Init is a pure function but returns a volatile type."); + function Init return X + with + Volatile_Function; + +private + type A is limited record + E : Integer; + end record + with + Volatile; + -- and Async_Readers when implemented; + + type X is limited new A; +end BIP_Overlay; -- 2.30.2