Commit e51102b2 by Arnaud Charlet

[multiple changes]

2017-01-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sinfo.ads: Minor reformatting.

2017-01-12  Gary Dismukes  <dismukes@adacore.com>

	* exp_util.adb, exp_util.ads, einfo.ads: Minor typo fixes and
	reformatting.

2017-01-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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
parent 6e759c2a
2017-01-12 Hristian Kirtchev <kirtchev@adacore.com>
* sinfo.ads: Minor reformatting.
2017-01-12 Gary Dismukes <dismukes@adacore.com>
* exp_util.adb, exp_util.ads, einfo.ads: Minor typo fixes and
reformatting.
2017-01-12 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <duff@adacore.com>
* contracts.adb, einfo.adb, errout.adb, exp_attr.adb,
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 --
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment