[multiple changes]

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
	Indefinite or limited library level objects are now returned on
	the heap.
	* exp_ch7.adb (Build_Finalization_Master): Add formal
	parameter For_Lib_Level. Add context specific insertion for a
	finalization master created for an access result type related
	to a build-in-place function call used to initialize a library
	level object.
	* exp_ch7.ads (Build_Finalization_Master): Add formal parameter
	For_Lib_Level. Update the comment on usage.
	* sem_util.adb (Mark_Coextensions): Code cleanup.

2015-10-16  Emmanuel Briot  <briot@adacore.com>

	* prj.adb (For_Every_Project_Imported_Context): Fix handling
	of aggregated projects with duplicate names.
	* a-ngelfu.ads: Minor whitespace fix.

From-SVN: r228899
This commit is contained in:
Arnaud Charlet 2015-10-16 15:14:24 +02:00
parent f99a9fea99
commit 8434cfc767
7 changed files with 124 additions and 44 deletions

View File

@ -1,3 +1,23 @@
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
Indefinite or limited library level objects are now returned on
the heap.
* exp_ch7.adb (Build_Finalization_Master): Add formal
parameter For_Lib_Level. Add context specific insertion for a
finalization master created for an access result type related
to a build-in-place function call used to initialize a library
level object.
* exp_ch7.ads (Build_Finalization_Master): Add formal parameter
For_Lib_Level. Update the comment on usage.
* sem_util.adb (Mark_Coextensions): Code cleanup.
2015-10-16 Emmanuel Briot <briot@adacore.com>
* prj.adb (For_Every_Project_Imported_Context): Fix handling
of aggregated projects with duplicate names.
* a-ngelfu.ads: Minor whitespace fix.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Build_Predicate_Functions): The expression for

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2012-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2012-2015, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -61,8 +61,7 @@ package Ada.Numerics.Generic_Elementary_Functions is
and then (if X >= Float_Type'Succ (0.0) then Sqrt'Result > 0.0);
function Log (X : Float_Type'Base) return Float_Type'Base
with
function Log (X : Float_Type'Base) return Float_Type'Base with
Post => (if X = 1.0 then Log'Result = 0.0);
function Log (X, Base : Float_Type'Base) return Float_Type'Base with

View File

@ -8921,13 +8921,13 @@ package body Exp_Ch6 is
end if;
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call,
Function_Id,
(Function_Call => Func_Call,
Function_Id => Function_Id,
Alloc_Form_Exp =>
New_Occurrence_Of
(Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form),
Loc),
Pool_Actual => Pool_Actual);
(Build_In_Place_Formal
(Enclosing_Func, BIP_Alloc_Form), Loc),
Pool_Actual => Pool_Actual);
-- Otherwise, if enclosing function has a definite result subtype,
-- then caller allocation will be used.
@ -8979,6 +8979,35 @@ package body Exp_Ch6 is
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-- The allocation for indefinite library level objects occurs on the
-- heap as opposed to the secondary stack. This accomodates DLLs where
-- the secondary stack is destroyed after each library unload. This is
-- a hybrid mechanism where a stack-allocated object lives on the heap.
elsif Is_Library_Level_Entity (Defining_Identifier (Object_Decl))
and then not Restriction_Active (No_Implicit_Heap_Allocations)
then
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Global_Heap);
Caller_Object := Empty;
-- Create a finalization master for the access result type to ensure
-- that the heap allocation can properly chain the object and later
-- finalize it when the library unit does out of scope.
if Needs_Finalization (Etype (Func_Call)) then
Build_Finalization_Master
(Typ => Ptr_Typ,
For_Lib_Level => True,
Insertion_Node => Ptr_Typ_Decl);
Fmaster_Actual :=
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Finalization_Master (Ptr_Typ), Loc),
Attribute_Name => Name_Unrestricted_Access);
end if;
-- In other indefinite cases, pass an indication to do the allocation
-- on the secondary stack and set Caller_Object to Empty so that a null
-- value will be passed for the caller's object address. A transient

View File

@ -763,6 +763,7 @@ package body Exp_Ch7 is
procedure Build_Finalization_Master
(Typ : Entity_Id;
For_Anonymous : Boolean := False;
For_Lib_Level : Boolean := False;
For_Private : Boolean := False;
Context_Scope : Entity_Id := Empty;
Insertion_Node : Node_Id := Empty)
@ -1039,6 +1040,15 @@ package body Exp_Ch7 is
Pop_Scope;
-- The finalization master belongs to an access result type related
-- to a build-in-place function call used to initialize a library
-- level object. The master must be inserted in front of the access
-- result type declaration denoted by Insertion_Node.
elsif For_Lib_Level then
pragma Assert (Present (Insertion_Node));
Insert_Actions (Insertion_Node, Actions);
-- Otherwise the finalization master and its initialization become a
-- part of the freeze node.

View File

@ -100,18 +100,21 @@ package Exp_Ch7 is
procedure Build_Finalization_Master
(Typ : Entity_Id;
For_Anonymous : Boolean := False;
For_Lib_Level : Boolean := False;
For_Private : Boolean := False;
Context_Scope : Entity_Id := Empty;
Insertion_Node : Node_Id := Empty);
-- Build a finalization master for an access type. The designated type may
-- not necessarely be controlled or need finalization actions depending on
-- the context. Flag For_Anonymous must be set when creating a master for
-- an anonymous access type. Flag For_Private must be set when the
-- designated type contains a private component. Parameters Context_Scope
-- and Insertion_Node must be used in conjunction with flags For_Anonymous
-- and For_Private. Context_Scope is the scope of the context where the
-- finalization master must be analyzed. Insertion_Node is the insertion
-- point before which the master is inserted.
-- an anonymous access type. Flag For_Lib_Level must be set when creating
-- a master for a build-in-place function call access result type. Flag
-- For_Private must be set when the designated type contains a private
-- component. Parameters Context_Scope and Insertion_Node must be used in
-- conjunction with flags For_Anonymous and For_Private. Context_Scope is
-- the scope of the context where the finalization master must be analyzed.
-- Insertion_Node is the insertion point before which the master is to be
-- inserted.
procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
-- Build one controlling procedure when a late body overrides one of

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -592,9 +592,14 @@ package body Prj is
In_Aggregate_Lib : Boolean;
From_Encapsulated_Lib : Boolean)
is
package Name_Id_Set is
new Ada.Containers.Ordered_Sets (Element_Type => Path_Name_Type);
Seen_Name : Name_Id_Set.Set;
-- This set is needed to ensure that we do not handle the same
-- project twice in the context of aggregate libraries.
-- Since duplicate project names are possible in the context of
-- aggregated projects, we need to check the full paths
procedure Recursive_Check
(Project : Project_Id;
@ -673,12 +678,12 @@ package body Prj is
-- Start of processing for Recursive_Check
begin
if not Seen_Name.Contains (Project.Name) then
if not Seen_Name.Contains (Project.Path.Name) then
-- Even if a project is aggregated multiple times in an
-- aggregated library, we will only return it once.
Seen_Name.Include (Project.Name);
Seen_Name.Include (Project.Path.Name);
if not Imported_First then
Action

View File

@ -14214,41 +14214,55 @@ package body Sem_Util is
-- Start of processing Mark_Coextensions
begin
case Nkind (Context_Nod) is
-- An allocator that appears on the right hand side of an assignment is
-- treated as a potentially dynamic coextension when the right hand side
-- is an allocator or a qualified expression.
-- Comment here ???
-- Obj := new ...'(new Coextension ...);
when N_Assignment_Statement =>
Is_Dynamic := Nkind (Expression (Context_Nod)) = N_Allocator;
if Nkind (Context_Nod) = N_Assignment_Statement then
Is_Dynamic :=
Nkind_In (Expression (Context_Nod), N_Allocator,
N_Qualified_Expression);
-- An allocator that is a component of a returned aggregate
-- must be dynamic.
-- An allocator that appears within the expression of a simple return
-- statement is treated as a potentially dynamic coextension when the
-- expression is either aggregate, allocator or qualified expression.
when N_Simple_Return_Statement =>
declare
Expr : constant Node_Id := Expression (Context_Nod);
begin
Is_Dynamic :=
Nkind (Expr) = N_Allocator
or else
(Nkind (Expr) = N_Qualified_Expression
and then Nkind (Expression (Expr)) = N_Aggregate);
end;
-- return (new Coextension ...);
-- return new ...'(new Coextension ...);
-- An alloctor within an object declaration in an extended return
-- statement is of necessity dynamic.
elsif Nkind (Context_Nod) = N_Simple_Return_Statement then
Is_Dynamic :=
Nkind_In (Expression (Context_Nod), N_Aggregate,
N_Allocator,
N_Qualified_Expression);
when N_Object_Declaration =>
Is_Dynamic := Nkind (Root_Nod) = N_Allocator
or else
Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement;
-- An alloctor that appears within the initialization expression of an
-- object declaration is considered a potentially dynamic coextension
-- when the initialization expression is an allocator or a qualified
-- expression.
-- This routine should not be called for constructs which may not
-- contain coextensions.
-- Obj : ... := new ...'(new Coextension ...);
when others =>
raise Program_Error;
end case;
-- A similar case arises when the object declaration is part of an
-- extended return statement.
-- return Obj : ... := new ...'(new Coextension ...);
-- return Obj : ... := (new Coextension ...);
elsif Nkind (Context_Nod) = N_Object_Declaration then
Is_Dynamic :=
Nkind_In (Root_Nod, N_Allocator, N_Qualified_Expression)
or else
Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement;
-- This routine should not be called with constructs which may not
-- contain coextensions.
else
raise Program_Error;
end if;
Mark_Allocators (Root_Nod);
end Mark_Coextensions;