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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-01-11 Ed Schonberg <schonb...@adacore.com>
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.
--- gcc/ada/exp_ch6.adb
+++ 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;--- gcc/ada/freeze.adb
+++ 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));--- /dev/null
new file mode 100644
+++ 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;--- /dev/null
new file mode 100644
+++ 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;