From: Arnaud Charlet Date: Wed, 6 Feb 2013 10:13:51 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d2a6bd6bb570c3ece919323e9a01fe3c2beec08d;p=gcc.git [multiple changes] 2013-02-06 Ed Schonberg * 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 * 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 * einfo.ads: Minor reformatting. (Status_Flag_Or_Transient_Decl): Add ??? comment. From-SVN: r195791 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6cc022acfe3..e7b259a0afc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2013-02-06 Ed Schonberg + + * 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 + + * 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 + + * einfo.ads: Minor reformatting. + (Status_Flag_Or_Transient_Decl): Add ??? comment. + 2013-02-06 Hristian Kirtchev * exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index a0ca4c61a43..37c6dd1e8ca 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1266a3deb80..0f33b7f375c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 56b1d630599..f8d37a5530f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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)), - - 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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 267d50c6dca..fad6ae0b004 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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