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