From e51102b29c1489ded25723b8149f44a32ff10696 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 12 Jan 2017 14:21:21 +0100 Subject: [PATCH] [multiple changes] 2017-01-12 Hristian Kirtchev * sinfo.ads: Minor reformatting. 2017-01-12 Gary Dismukes * exp_util.adb, exp_util.ads, einfo.ads: Minor typo fixes and reformatting. 2017-01-12 Hristian Kirtchev * exp_ch6.adb (Make_Build_In_Place_Call_In_Anonymous_Context): Add new variable Definite. Create a local object and pass its 'Access to the BIP function when the result type is either definite or it does not require any finalization or secondary stack management. From-SVN: r244353 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/einfo.ads | 10 +++++----- gcc/ada/exp_ch6.adb | 16 ++++++++++++++-- gcc/ada/exp_util.adb | 10 +++++----- gcc/ada/exp_util.ads | 8 ++++---- gcc/ada/sinfo.ads | 15 ++++++++------- 6 files changed, 52 insertions(+), 23 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 17a96807d2a..37066f1d456 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2017-01-12 Hristian Kirtchev + + * sinfo.ads: Minor reformatting. + +2017-01-12 Gary Dismukes + + * exp_util.adb, exp_util.ads, einfo.ads: Minor typo fixes and + reformatting. + +2017-01-12 Hristian Kirtchev + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Anonymous_Context): Add new + variable Definite. Create a local object and pass its 'Access to the + BIP function when the result type is either definite or it does not + require any finalization or secondary stack management. + 2017-01-12 Bob Duff * contracts.adb, einfo.adb, errout.adb, exp_attr.adb, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index fd63ac5f431..b9354311e64 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -927,7 +927,7 @@ package Einfo is -- when the type is subject to pragma Default_Initial_Condition (DIC), or -- when the type inherits a DIC pragma from a parent type. Points to the -- entity of a procedure which takes a single argument of the given type --- and verifies the assertion expression of the DIC pragma at runtime. +-- and verifies the assertion expression of the DIC pragma at run time. -- Note: the reason this is marked as a synthesized attribute is that the -- way this is stored is as an element of the Subprograms_For_Type field. @@ -1760,7 +1760,7 @@ package Einfo is -- Defined in functions and generic functions. Set if there is one or -- more missing return statements in the function. This is used to -- control wrapping of the body in Exp_Ch6 to ensure that the program --- error exception is correctly raised in this case at runtime. +-- error exception is correctly raised in this case at run time. -- Has_Nested_Block_With_Handler (Flag101) -- Defined in scope entities. Set if there is a nested block within the @@ -2370,7 +2370,7 @@ package Einfo is -- Defined in record types and subtypes. Set if the type was created -- by the expander to represent a task or protected type. For every -- concurrent type, such as record type is constructed, and task and --- protected objects are instances of this record type at runtime +-- protected objects are instances of this record type at run time -- (The backend will replace declarations of the concurrent type using -- the declarations of the corresponding record type). See Exp_Ch9 for -- further details. @@ -2432,7 +2432,7 @@ package Einfo is -- Is_DIC_Procedure (Flag132) -- Defined in functions and procedures. Set for a generated procedure -- which verifies the assumption of pragma Default_Initial_Condition at --- runtime. +-- run time. -- Is_Discrete_Or_Fixed_Point_Type (synthesized) -- Applies to all entities, true for all discrete types and subtypes @@ -3956,7 +3956,7 @@ package Einfo is -- the expanded N_Procedure_Call_Statement node for this call. It -- is used for Import/Export_Exception processing to modify the -- register call to make appropriate entries in the special tables --- used for handling these pragmas at runtime. +-- used for handling these pragmas at run time. -- Related_Array_Object (Node25) -- Defined in array types and subtypes. Used only for the base type diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 85c381fca9b..ff17867ff1e 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7529,6 +7529,14 @@ package body Exp_Ch6 is Return_Obj_Id : Entity_Id; Return_Obj_Decl : Entity_Id; + Definite : Boolean; + -- True if result subtype is definite, or has a size that does not + -- require secondary stack usage (i.e. no variant part or components + -- whose type depends on discriminants). In particular, untagged types + -- with only access discriminants do not require secondary stack use. + -- Note that if the return type is tagged we must always use the sec. + -- stack because the call may dispatch on result. + begin -- Step past qualification, type conversion (which can occur in actual -- parameter contexts), and unchecked conversion (which can occur in @@ -7568,6 +7576,10 @@ package body Exp_Ch6 is end if; Result_Subt := Etype (Function_Id); + Definite := + (Is_Definite_Subtype (Underlying_Type (Result_Subt)) + and then not Is_Tagged_Type (Result_Subt)) + or else not Requires_Transient_Scope (Underlying_Type (Result_Subt)); -- If the build-in-place function returns a controlled object, then the -- object needs to be finalized immediately after the context. Since @@ -7606,10 +7618,10 @@ package body Exp_Ch6 is Analyze (Function_Call); end; - -- When the result subtype is constrained, an object of the subtype is + -- When the result subtype is definite, an object of the subtype is -- declared and an access value designating it is passed as an actual. - elsif Is_Constrained (Underlying_Type (Result_Subt)) then + elsif Definite then -- Create a temporary object to hold the function result diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1529c562b9c..7791ad46f37 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1102,7 +1102,7 @@ package body Exp_Util is -- In SPARK mode, reject an inherited condition for an -- inherited operation if it contains a call to an overriding - -- operation, because this implies that the pre/postcondition + -- operation, because this implies that the pre/postconditions -- of the inherited operation have changed silently. elsif SPARK_Mode = On @@ -1206,7 +1206,7 @@ package body Exp_Util is Deriv_Typ : Entity_Id; Stmts : in out List_Id); -- Add a runtime check to verify the assertion expression of inherited - -- pragma DIC_Prag. Par_Typ is parent type which is also the owner of + -- pragma DIC_Prag. Par_Typ is parent type, which is also the owner of -- the DIC pragma. Deriv_Typ is the derived type inheriting the DIC -- pragma. All generated code is added to list Stmts. @@ -1454,7 +1454,7 @@ package body Exp_Util is begin Expr := New_Copy_Tree (DIC_Expr); - -- Perform the following substituion: + -- Perform the following substitution: -- * Replace the current instance of DIC_Typ with a reference to -- the _object formal parameter of the DIC procedure. @@ -2056,7 +2056,7 @@ package body Exp_Util is pragma Assert (Present (Typ_Decl)); -- Create the formal parameter which emulates the variable-like behavior - -- of the current type instance. + -- of the type's current instance. Obj_Id := Make_Defining_Identifier (Loc, Chars => Name_uObject); @@ -2083,7 +2083,7 @@ package body Exp_Util is New_Occurrence_Of (Work_Typ, Loc))))); -- The declaration should not be inserted into the tree when the context - -- is ASIS, GNATprove or a generic unit because it is not part of the + -- is ASIS, GNATprove, or a generic unit because it is not part of the -- template. if ASIS_Mode or GNATprove_Mode or Inside_A_Generic then diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index d02b6b63935..584c2df6ba6 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -254,11 +254,11 @@ package Exp_Util is Adjust_Sloc : Boolean); -- Build the expression for an inherited class-wide condition. Prag is -- the pragma constructed from the corresponding aspect of the parent - -- subprogram, and Subp is the overriding operation and Par_Subp is + -- subprogram, and Subp is the overriding operation, and Par_Subp is -- the overridden operation that has the condition. Adjust_Sloc is True -- when the sloc of nodes traversed should be adjusted for the inherited -- pragma. The routine is also called to check whether an inherited - -- operation that is not overridden but has inherited conditions need + -- operation that is not overridden but has inherited conditions needs -- a wrapper, because the inherited condition includes calls to other -- primitives that have been overridden. In that case the first argument -- is the expression of the original class-wide aspect. In SPARK_Mode, such @@ -274,11 +274,11 @@ package Exp_Util is procedure Build_DIC_Procedure_Body (Typ : Entity_Id); -- Create the body of the procedure which verifies the assertion expression - -- of pragma Default_Initial_Condition at runtime. + -- of pragma Default_Initial_Condition at run time. procedure Build_DIC_Procedure_Declaration (Typ : Entity_Id); -- Create the declaration of the procedure which verifies the assertion - -- expression of pragma Default_Initial_Condition at runtime. + -- expression of pragma Default_Initial_Condition at run time. procedure Build_Procedure_Form (N : Node_Id); -- Create a procedure declaration which emulates the behavior of a function diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index a0bfd46e572..6c5472a1d9c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11019,10 +11019,6 @@ package Sinfo is -- Utility Functions -- ----------------------- - function Pragma_Name_Unmapped (N : Node_Id) return Name_Id; - -- Function to obtain Chars field of Pragma_Identifier. In most cases, you - -- want to call Pragma_Name instead. - procedure Map_Pragma_Name (From, To : Name_Id); -- Used in the implementation of pragma Rename_Pragma. Maps pragma name -- From to pragma name To, so From can be used as a synonym for To. @@ -11033,9 +11029,14 @@ package Sinfo is -- once or twice. function Pragma_Name (N : Node_Id) return Name_Id; - -- Same as Pragma_Name_Unmapped, except that if From has been mapped to To, - -- and Pragma_Name_Unmapped (N) = From, then this returns To. In other - -- words, this takes into account pragmas Rename_Pragma. + -- Obtain the name of pragma N from the Chars field of its identifier. If + -- the pragma has been renamed using Rename_Pragma, this routine returns + -- the name of the renaming. + + function Pragma_Name_Unmapped (N : Node_Id) return Name_Id; + -- Obtain the name of pragma N from the Chars field of its identifier. This + -- form of name extraction does not take into account renamings performed + -- by Rename_Pragma. ----------------------------- -- Syntactic Parent Tables -- -- 2.30.2