From 8434cfc76762f3306fca614b875e3d7625ff001f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 16 Oct 2015 15:14:24 +0200 Subject: [PATCH] [multiple changes] 2015-10-16 Hristian Kirtchev * 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 * prj.adb (For_Every_Project_Imported_Context): Fix handling of aggregated projects with duplicate names. * a-ngelfu.ads: Minor whitespace fix. From-SVN: r228899 --- gcc/ada/ChangeLog | 20 +++++++++++++ gcc/ada/a-ngelfu.ads | 5 ++-- gcc/ada/exp_ch6.adb | 39 +++++++++++++++++++++---- gcc/ada/exp_ch7.adb | 10 +++++++ gcc/ada/exp_ch7.ads | 15 ++++++---- gcc/ada/prj.adb | 11 +++++-- gcc/ada/sem_util.adb | 68 ++++++++++++++++++++++++++------------------ 7 files changed, 124 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 47c186cd77c..a4696b5ad4e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2015-10-16 Hristian Kirtchev + + * 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 + + * 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 * sem_ch13.adb (Build_Predicate_Functions): The expression for diff --git a/gcc/ada/a-ngelfu.ads b/gcc/ada/a-ngelfu.ads index 8afb7332204..8b257b62b41 100644 --- a/gcc/ada/a-ngelfu.ads +++ b/gcc/ada/a-ngelfu.ads @@ -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 diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c2165438bf4..4733eb4f83a 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 44289952680..2f90c92cbe3 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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. diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index eac45dc0b63..3f90f31580e 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -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 diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 0deb39beb29..3d71bde3874 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d5a798043fc..bd47c150a83 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; -- 2.30.2