+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
------------------------------------------------------------------------------
with Atree; use Atree;
+with Aspects; use Aspects;
with Checks; use Checks;
with Contracts; use Contracts;
with Debug; use Debug;
-- 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;
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));
+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.
--- /dev/null
+-- { 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
+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;
projects / gcc.git / commitdiff