+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
-- --
-- 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 --
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
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.
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
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)
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.
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
-- --
-- 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- --
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;
-- 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
-- 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;
projects / gcc.git / commitdiff