+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
-- --
-- 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- --
-- 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)
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);
-- --
-- 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- --
-- 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
-- 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.
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.
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 ...);
-- 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;
-- 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)),
-
- Then_Statements => New_List (
- Make_Final_Call
- (Obj_Ref =>
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Temp_Id, Loc)),
- Typ => Desig_Typ),
+ -- 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.
+
+ 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)),
+
+ 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)))));
+ 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
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
projects / gcc.git / commitdiff