+2017-12-15 Patrick Bernardi <bernardi@adacore.com>
+
+ * doc/gnat_ugn/gnat_and_program_execution.rst: Update section "Dynamic
+ Stack Usage Analysis" to include more details about GNAT_STACK_LIMIT.
+
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.adb (Add_Own_DIC): Ensure that the expression of the pragma
+ is available (Is_Verifiable_DIC_Pragma): Moved from Sem_Util.
+ * sem_util.adb (Has_Full_Default_Initialization):
+ Has_Fully_Default_Initializing_DIC_Pragma is now used to determine
+ whether a type has full default initialization due to pragma
+ Default_Initial_Condition.
+ (Has_Fully_Default_Initializing_DIC_Pragma): New routine.
+ (Is_Verifiable_DIC_Pragma): Moved to Exp_Util.
+ * sem_util.ads (Has_Fully_Default_Initializing_DIC_Pragma): New
+ routine.
+ (Is_Verifiable_DIC_Pragma): Moved to Exp_Util.
+ * sem_warn.adb (Is_OK_Fully_Initialized):
+ Has_Fully_Default_Initializing_DIC_Pragma is now used to determine
+ whether a type has full default initialization due to pragma
+ Default_Initial_Condition.
+
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Match_Constituent): Do not quietly accept constants as
+ suitable constituents.
+ * exp_util.adb: Minor reformatting.
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_aggr.adb (In_Place_Assign_OK): Extend the predicate to recognize
+ an array aggregate in an allocator, when the designated type is
+ unconstrained and the upper bound of the aggregate belongs to the base
+ type of the index.
+
+2017-12-15 Bob Duff <duff@adacore.com>
+
+ * exp_ch6.adb (Expand_N_Extended_Return_Statement,
+ Expand_Simple_Function_Return): Assert that the b-i-p-ness of the
+ caller and callee match. Otherwise, we would need some substantial
+ changes to allow b-i-p calls non-b-i-p, and vice versa.
+
2017-12-15 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Unnest_Subprograms): Nothing to do if the main unit is
is not entirely analyzed, and it's not possible to know exactly how
much has actually been used.
-The environment task stack, e.g., the stack that contains the main unit, is
-only processed when the environment variable GNAT_STACK_LIMIT is set.
+By default the environment task stack, the stack that contains the main unit,
+is not processed. To enable processing of the environment task stack, the
+environment variable GNAT_STACK_LIMIT needs to be set to the maximum size of
+the environment task stack. This amount is given in kilobytes. For example:
+
+ ::
+
+ $ set GNAT_STACK_LIMIT 1600
+
+would specify to the analyzer that the environment task stack has a limit
+of 1.6 megabytes. Any stack usage beyond this will be ignored by the analysis.
The package ``GNAT.Task_Stack_Usage`` provides facilities to get
-stack usage reports at run-time. See its body for the details.
+stack-usage reports at run time. See its body for the details.
Get_Index_Bounds (Obj_In, Obj_Lo, Obj_Hi);
if not Compile_Time_Known_Value (Aggr_Lo)
- or else not Compile_Time_Known_Value (Aggr_Hi)
or else not Compile_Time_Known_Value (Obj_Lo)
or else not Compile_Time_Known_Value (Obj_Hi)
or else Expr_Value (Aggr_Lo) /= Expr_Value (Obj_Lo)
- or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
then
return False;
+
+ -- For an assignment statement we require static matching
+ -- of bounds. Ditto for an allocator whose qualified
+ -- expression is a constrained type. If the expression in
+ -- the allocator is an unconstrained array, we accept an
+ -- upper bound that is not static, to allow for non-static
+ -- expressions of the base type. Clearly there are further
+ -- possibilities (with diminishing returns) for safely
+ -- building arrays in place here.
+
+ elsif Nkind (Parent (N)) = N_Assignment_Statement
+ or else Is_Constrained (Etype (Parent (N)))
+ then
+ if not Compile_Time_Known_Value (Aggr_Hi)
+ or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
+ then
+ return False;
+ end if;
end if;
Next_Index (Aggr_In);
if Nkind (Ret_Obj_Decl) = N_Object_Declaration then
Exp := Expression (Ret_Obj_Decl);
+
+ -- Assert that if F says "return R : T := G(...) do..."
+ -- then F and G are both b-i-p, or neither b-i-p.
+
+ if Nkind (Exp) = N_Function_Call then
+ pragma Assert (Ekind (Current_Scope) = E_Function);
+ pragma Assert
+ (Is_Build_In_Place_Function (Current_Scope) =
+ Is_Build_In_Place_Function_Call (Exp));
+ null;
+ end if;
else
Exp := Empty;
end if;
end if;
end if;
+ -- Assert that if F says "return G(...);"
+ -- then F and G are both b-i-p, or neither b-i-p.
+
+ if Nkind (Exp) = N_Function_Call then
+ pragma Assert (Ekind (Scope_Id) = E_Function);
+ pragma Assert
+ (Is_Build_In_Place_Function (Scope_Id) =
+ Is_Build_In_Place_Function_Call (Exp));
+ null;
+ end if;
+
-- For the case of a simple return that does not come from an
-- extended return, in the case of build-in-place, we rewrite
-- "return <expression>;" to be:
return Empty;
end Associated_Expr;
- -- Start of processing for Expand_Simple_Function_Return
-
begin
if not Positionals_Exhausted then
Disc_Exp := First (Expressions (Discrim_Source));
-- Force evaluation of bounds of a slice, which may be given by a range
-- or by a subtype indication with or without a constraint.
+ function Is_Verifiable_DIC_Pragma (Prag : Node_Id) return Boolean;
+ -- Determine whether pragma Default_Initial_Condition denoted by Prag has
+ -- an assertion expression that should be verified at run time.
+
function Make_CW_Equivalent_Type
(T : Entity_Id;
E : Node_Id) return Entity_Id;
-- Start of processing for Add_Own_DIC
begin
+ pragma Assert (Present (DIC_Expr));
Expr := New_Copy_Tree (DIC_Expr);
-- Perform the following substitution:
-- Produce an empty completing body in the following cases:
-- * Assertions are disabled
-- * The DIC Assertion_Policy is Ignore
- -- * Pragma DIC appears without an argument
- -- * Pragma DIC appears with argument "null"
if No (Stmts) then
Stmts := New_List (Make_Null_Statement (Loc));
and then Is_Itype (Full_Typ);
end Is_Untagged_Private_Derivation;
+ ------------------------------
+ -- Is_Verifiable_DIC_Pragma --
+ ------------------------------
+
+ function Is_Verifiable_DIC_Pragma (Prag : Node_Id) return Boolean is
+ Args : constant List_Id := Pragma_Argument_Associations (Prag);
+
+ begin
+ -- To qualify as verifiable, a DIC pragma must have a non-null argument
+
+ return
+ Present (Args)
+ and then Nkind (Get_Pragma_Arg (First (Args))) /= N_Null;
+ end Is_Verifiable_DIC_Pragma;
+
---------------------------
-- Is_Volatile_Reference --
---------------------------
end loop;
end if;
- -- Constants are part of the hidden state of a package, but
- -- the compiler cannot determine whether they have variable
- -- input (SPARK RM 7.1.1(2)) and cannot classify them as a
- -- hidden state. Accept the constant quietly even if it is
- -- a visible state or lacks a Part_Of indicator.
+ -- At this point it is known that the constituent is not
+ -- part of the package hidden state and cannot be used in
+ -- a refinement (SPARK RM 7.2.2(9)).
- if Ekind (Constit_Id) = E_Constant then
- Collect_Constituent;
-
- -- If we get here, then the constituent is not a hidden
- -- state of the related package and may not be used in a
- -- refinement (SPARK RM 7.2.2(9)).
-
- else
- Error_Msg_Name_1 := Chars (Spec_Id);
- SPARK_Msg_NE
- ("cannot use & in refinement, constituent is not a "
- & "hidden state of package %", Constit, Constit_Id);
- end if;
+ Error_Msg_Name_1 := Chars (Spec_Id);
+ SPARK_Msg_NE
+ ("cannot use & in refinement, constituent is not a hidden "
+ & "state of package %", Constit, Constit_Id);
end if;
end Match_Constituent;
function Has_Full_Default_Initialization (Typ : Entity_Id) return Boolean is
Comp : Entity_Id;
- Prag : Node_Id;
begin
- -- A type subject to pragma Default_Initial_Condition is fully default
- -- initialized when the pragma appears with a non-null argument. Since
- -- any type may act as the full view of a private type, this check must
- -- be performed prior to the specialized tests below.
+ -- A type subject to pragma Default_Initial_Condition may be fully
+ -- default initialized depending on inheritance and the argument of
+ -- the pragma. Since any type may act as the full view of a private
+ -- type, this check must be performed prior to the specialized tests
+ -- below.
- if Has_DIC (Typ) then
- Prag := Get_Pragma (Typ, Pragma_Default_Initial_Condition);
- pragma Assert (Present (Prag));
-
- return Is_Verifiable_DIC_Pragma (Prag);
+ if Has_Fully_Default_Initializing_DIC_Pragma (Typ) then
+ return True;
end if;
-- A scalar type is fully default initialized if it is subject to aspect
end if;
end Has_Full_Default_Initialization;
+ -----------------------------------------------
+ -- Has_Fully_Default_Initializing_DIC_Pragma --
+ -----------------------------------------------
+
+ function Has_Fully_Default_Initializing_DIC_Pragma
+ (Typ : Entity_Id) return Boolean
+ is
+ Args : List_Id;
+ Prag : Node_Id;
+
+ begin
+ -- A type that inherits pragma Default_Initial_Condition from a parent
+ -- type is automatically fully default initialized.
+
+ if Has_Inherited_DIC (Typ) then
+ return True;
+
+ -- Otherwise the type is fully default initialized only when the pragma
+ -- appears without an argument, or the argument is non-null.
+
+ elsif Has_Own_DIC (Typ) then
+ Prag := Get_Pragma (Typ, Pragma_Default_Initial_Condition);
+ pragma Assert (Present (Prag));
+ Args := Pragma_Argument_Associations (Prag);
+
+ -- The pragma appears without an argument in which case it defaults
+ -- to True.
+
+ if No (Args) then
+ return True;
+
+ -- The pragma appears with a non-null expression
+
+ elsif Nkind (Get_Pragma_Arg (First (Args))) /= N_Null then
+ return True;
+ end if;
+ end if;
+
+ return False;
+ end Has_Fully_Default_Initializing_DIC_Pragma;
+
--------------------
-- Has_Infinities --
--------------------
end if;
end Is_Variable;
- ------------------------------
- -- Is_Verifiable_DIC_Pragma --
- ------------------------------
-
- function Is_Verifiable_DIC_Pragma (Prag : Node_Id) return Boolean is
- Args : constant List_Id := Pragma_Argument_Associations (Prag);
-
- begin
- -- To qualify as verifiable, a DIC pragma must have a non-null argument
-
- return
- Present (Args)
- and then Nkind (Get_Pragma_Arg (First (Args))) /= N_Null;
- end Is_Verifiable_DIC_Pragma;
-
---------------------------
-- Is_Visibly_Controlled --
---------------------------
-- either include a default expression or have a type which defines
-- full default initialization. In the case of type extensions, the
-- parent type defines full default initialization.
- -- * A task type
- -- * A private type whose Default_Initial_Condition is non-null
+ -- * A task type
+ -- * A private type with pragma Default_Initial_Condition that provides
+ -- full default initialization.
+
+ function Has_Fully_Default_Initializing_DIC_Pragma
+ (Typ : Entity_Id) return Boolean;
+ -- Determine whether type Typ has a suitable Default_Initial_Condition
+ -- pragma which provides the full default initialization of the type.
function Has_Infinities (E : Entity_Id) return Boolean;
-- Determines if the range of the floating-point type E includes
-- default is True since this routine is commonly invoked as part of the
-- semantic analysis and it must not be disturbed by the rewriten nodes.
- function Is_Verifiable_DIC_Pragma (Prag : Node_Id) return Boolean;
- -- Determine whether pragma Default_Initial_Condition denoted by Prag has
- -- an assertion expression which should be verified at runtime.
-
function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
-- Check whether T is derived from a visibly controlled type. This is true
-- if the root type is declared in Ada.Finalization. If T is derived
-----------------------------
function Is_OK_Fully_Initialized return Boolean is
- Prag : Node_Id;
-
begin
if Is_Access_Type (Typ) and then Is_Dereferenced (N) then
return False;
- -- A type subject to pragma Default_Initial_Condition is fully
- -- default initialized when the pragma appears with a non-null
- -- argument (SPARK RM 3.1 and SPARK RM 7.3.3).
-
- elsif Has_DIC (Typ) then
- Prag := Get_Pragma (Typ, Pragma_Default_Initial_Condition);
- pragma Assert (Present (Prag));
+ -- A type subject to pragma Default_Initial_Condition may be fully
+ -- default initialized depending on inheritance and the argument of
+ -- the pragma (SPARK RM 3.1 and SPARK RM 7.3.3).
- return Is_Verifiable_DIC_Pragma (Prag);
+ elsif Has_Fully_Default_Initializing_DIC_Pragma (Typ) then
+ return True;
else
return Is_Fully_Initialized_Type (Typ);
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * gnat.dg/dflt_init_cond.adb, gnat.dg/dflt_init_cond_pkg.ads: New
+ testcase.
+
2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/expr_func_main.adb, gnat.dg/expr_func_pkg.ads,
--- /dev/null
+-- { dg-do compile }
+
+with Dflt_Init_Cond_Pkg; use Dflt_Init_Cond_Pkg;
+
+procedure Dflt_Init_Cond is
+ E : Explicit;
+ I : Implicit;
+
+begin
+ Read (E);
+ Read (I);
+end Dflt_Init_Cond;
--- /dev/null
+package Dflt_Init_Cond_Pkg is
+ type Explicit is limited private with Default_Initial_Condition => True;
+ type Implicit is limited private with Default_Initial_Condition;
+
+ procedure Read (Obj : Explicit);
+ procedure Read (Obj : Implicit);
+
+private
+ type Implicit is access all Integer;
+ type Explicit is access all Integer;
+end Dflt_Init_Cond_Pkg;
projects / gcc.git / commitdiff