[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  <schonberg@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.

From-SVN: r256523

6 files changed, 129 insertions, 5 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b26e37..63c2a95 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2018-01-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <trojanek@adacore.com>
 
 	* 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 e52fb8c..c9d4043 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 1e6e257..08163ef 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 43dcbed..e6d2045 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-01-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/bip_overlay.adb, gnat.dg/bip_overlay.ads: New testcase.
+
 2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* 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 0000000..c4a3849
--- /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 0000000..9a564ff
--- /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;