[multiple changes]
2013-02-06 Ed Schonberg <schonberg@adacore.com> * checks.adb (Apply_Discriminant_Check): Look for discriminant constraint in full view of private type when needed. * sem_ch12.adb (Validate_Array_Type_Instance): Specialize previous patch to components types that are private and without discriminants. 2013-02-06 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch4.adb (Find_Enclosing_Context): Recognize a simple return statement as one of the cases that require special processing with respect to temporary controlled function results. (Process_Transient_Object): Do attempt to finalize a temporary controlled function result when the associated context is a simple return statement. Instead, leave this task to the general finalization mechanism. 2013-02-06 Thomas Quinot <quinot@adacore.com> * einfo.ads: Minor reformatting. (Status_Flag_Or_Transient_Decl): Add ??? comment. From-SVN: r195791
This commit is contained in:
Arnaud Charlet
parent
4c7e09908b
commit
d2a6bd6bb5
5 changed files with 87 additions and 34 deletions
|
|
@ -1,3 +1,26 @@
|
|||
2013-02-06 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* checks.adb (Apply_Discriminant_Check): Look for discriminant
|
||||
constraint in full view of private type when needed.
|
||||
* sem_ch12.adb (Validate_Array_Type_Instance): Specialize
|
||||
previous patch to components types that are private and without
|
||||
discriminants.
|
||||
|
||||
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Find_Enclosing_Context): Recognize
|
||||
a simple return statement as one of the cases that require special
|
||||
processing with respect to temporary controlled function results.
|
||||
(Process_Transient_Object): Do attempt to finalize a temporary
|
||||
controlled function result when the associated context is
|
||||
a simple return statement. Instead, leave this task to the
|
||||
general finalization mechanism.
|
||||
|
||||
2013-02-06 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* einfo.ads: Minor reformatting.
|
||||
(Status_Flag_Or_Transient_Decl): Add ??? comment.
|
||||
|
||||
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2013, 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- --
|
||||
|
|
@ -1536,8 +1536,8 @@ package body Checks is
|
|||
-- the constraints are constants. In this case, we can do the check
|
||||
-- successfully at compile time.
|
||||
|
||||
-- We skip this check for the case where the node is a rewritten`
|
||||
-- allocator, because it already carries the context subtype, and
|
||||
-- We skip this check for the case where the node is a rewritten`as
|
||||
-- an allocator, because it already carries the context subtype, and
|
||||
-- extracting the discriminants from the aggregate is messy.
|
||||
|
||||
if Is_Constrained (S_Typ)
|
||||
|
|
@ -1591,7 +1591,17 @@ package body Checks is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
DconT := First_Elmt (Discriminant_Constraint (T_Typ));
|
||||
-- Constraint may appear in full view of type
|
||||
|
||||
if Ekind (T_Typ) = E_Private_Subtype
|
||||
and then Present (Full_View (T_Typ))
|
||||
then
|
||||
DconT :=
|
||||
First_Elmt (Discriminant_Constraint (Full_View (T_Typ)));
|
||||
|
||||
else
|
||||
DconT := First_Elmt (Discriminant_Constraint (T_Typ));
|
||||
end if;
|
||||
|
||||
while Present (Discr) loop
|
||||
ItemS := Node (DconS);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2013, 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- --
|
||||
|
|
@ -3725,11 +3725,12 @@ package Einfo is
|
|||
|
||||
-- Status_Flag_Or_Transient_Decl (Node15)
|
||||
-- Defined in variables and constants. Applies to objects that require
|
||||
-- special treatment by the finalization machinery. Such examples are
|
||||
-- extended return results, if and case expression results and objects
|
||||
-- inside N_Expression_With_Actions nodes. The attribute contains the
|
||||
-- entity of a flag which specifies particular behavior over a region
|
||||
-- of code or the declaration of a "hook" object.
|
||||
-- special treatment by the finalization machinery, such as extended
|
||||
-- return results, IF and CASE expression results, and objects inside
|
||||
-- N_Expression_With_Actions nodes. The attribute contains the entity
|
||||
-- of a flag which specifies particular behavior over a region of code
|
||||
-- or the declaration of a "hook" object.
|
||||
-- In which case is it a flag, or a hook object???
|
||||
|
||||
-- Storage_Size_Variable (Node15) [implementation base type only]
|
||||
-- Defined in access types and task type entities. This flag is set
|
||||
|
|
|
|||
|
|
@ -5038,7 +5038,7 @@ package body Exp_Ch4 is
|
|||
-- Start of processing for Find_Enclosing_Context
|
||||
|
||||
begin
|
||||
-- The expression_with_action is in a case or if expression and
|
||||
-- The expression_with_actions is in a case/if expression and
|
||||
-- the lifetime of any temporary controlled object is therefore
|
||||
-- extended. Find a suitable insertion node by locating the top
|
||||
-- most case or if expressions.
|
||||
|
|
@ -5088,12 +5088,12 @@ package body Exp_Ch4 is
|
|||
|
||||
return Par;
|
||||
|
||||
-- Shor circuit operators in complex expressions are converted
|
||||
-- Short circuit operators in complex expressions are converted
|
||||
-- into expression_with_actions.
|
||||
|
||||
else
|
||||
-- Take care of the case where the expression_with_actions
|
||||
-- is burried deep inside an if statement. The temporary
|
||||
-- is buried deep inside an IF statement. The temporary
|
||||
-- function result must be finalized before the then, elsif
|
||||
-- or else statements are evaluated.
|
||||
|
||||
|
|
@ -5123,7 +5123,7 @@ package body Exp_Ch4 is
|
|||
|
||||
Top := Par;
|
||||
|
||||
-- The expression_with_action might be located in a pragm
|
||||
-- The expression_with_actions might be located in a pragma
|
||||
-- in which case locate the pragma itself:
|
||||
|
||||
-- pragma Precondition (... and then Ctrl_Func_Call ...);
|
||||
|
|
@ -5133,10 +5133,16 @@ package body Exp_Ch4 is
|
|||
|
||||
-- Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
|
||||
|
||||
-- Another case to consider is an expression_with_actions as
|
||||
-- part of a return statement:
|
||||
|
||||
-- return ... and then Ctrl_Func_Call ...;
|
||||
|
||||
while Present (Par) loop
|
||||
if Nkind_In (Par, N_Assignment_Statement,
|
||||
N_Object_Declaration,
|
||||
N_Pragma)
|
||||
N_Pragma,
|
||||
N_Simple_Return_Statement)
|
||||
then
|
||||
return Par;
|
||||
|
||||
|
|
@ -5238,23 +5244,32 @@ package body Exp_Ch4 is
|
|||
-- Temp := null;
|
||||
-- end if;
|
||||
|
||||
Insert_Action_After (Context,
|
||||
Make_If_Statement (Loc,
|
||||
Condition =>
|
||||
Make_Op_Ne (Loc,
|
||||
Left_Opnd => New_Reference_To (Temp_Id, Loc),
|
||||
Right_Opnd => Make_Null (Loc)),
|
||||
-- When the expression_with_actions is part of a return statement,
|
||||
-- there is no need to insert a finalization call, as the general
|
||||
-- finalization mechanism (see Build_Finalizer) would take care of
|
||||
-- the temporary function result on subprogram exit. Note that it
|
||||
-- would also be impossible to insert the finalization code after
|
||||
-- the return statement as this would make it unreachable.
|
||||
|
||||
Then_Statements => New_List (
|
||||
Make_Final_Call
|
||||
(Obj_Ref =>
|
||||
Make_Explicit_Dereference (Loc,
|
||||
Prefix => New_Reference_To (Temp_Id, Loc)),
|
||||
Typ => Desig_Typ),
|
||||
if Nkind (Context) /= N_Simple_Return_Statement then
|
||||
Insert_Action_After (Context,
|
||||
Make_If_Statement (Loc,
|
||||
Condition =>
|
||||
Make_Op_Ne (Loc,
|
||||
Left_Opnd => New_Reference_To (Temp_Id, Loc),
|
||||
Right_Opnd => Make_Null (Loc)),
|
||||
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Reference_To (Temp_Id, Loc),
|
||||
Expression => Make_Null (Loc)))));
|
||||
Then_Statements => New_List (
|
||||
Make_Final_Call
|
||||
(Obj_Ref =>
|
||||
Make_Explicit_Dereference (Loc,
|
||||
Prefix => New_Reference_To (Temp_Id, Loc)),
|
||||
Typ => Desig_Typ),
|
||||
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Reference_To (Temp_Id, Loc),
|
||||
Expression => Make_Null (Loc)))));
|
||||
end if;
|
||||
end Process_Transient_Object;
|
||||
|
||||
-- Start of processing for Process_Action
|
||||
|
|
|
|||
|
|
@ -10708,10 +10708,14 @@ package body Sem_Ch12 is
|
|||
or else Subtypes_Match
|
||||
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
|
||||
Component_Type (Act_T))
|
||||
or else Subtypes_Match
|
||||
(Base_Type
|
||||
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
|
||||
Component_Type (Act_T))
|
||||
or else
|
||||
(Is_Private_Type (Component_Type (A_Gen_T))
|
||||
and then not Has_Discriminants (Component_Type (A_Gen_T))
|
||||
and then
|
||||
Subtypes_Match
|
||||
(Base_Type
|
||||
(Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T)),
|
||||
Component_Type (Act_T)))
|
||||
then
|
||||
null;
|
||||
else
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue