From ac7120ce8aef83a746376463906782476b407e9b Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 10 Jul 2009 09:43:01 +0000 Subject: [PATCH] exp_util.adb: Minor code reorganization (use N_Short_Circuit) 2009-07-10 Robert Dewar * exp_util.adb: Minor code reorganization (use N_Short_Circuit) * exp_ch4.adb: Add ??? comment for conditional expressions on limited types. * checks.adb (In_Declarative_Region_Of_Subprogram_Body): New procedure, replaces Safe_To_Capture_In_Parameter_Value, and properly handles the case of conditional expressions that may not be elaborated. * sem_util.adb (Safe_To_Capture_Value): Properly handle case of conditional expression where we may not execute then then or else branches. From-SVN: r149468 --- gcc/ada/ChangeLog | 15 ++++++++++++ gcc/ada/checks.adb | 57 +++++++++++++++++++++++++++++++------------- gcc/ada/exp_ch4.adb | 18 ++++++++++++-- gcc/ada/exp_util.adb | 15 +++++------- gcc/ada/sem_util.adb | 20 +++++++++------- 5 files changed, 88 insertions(+), 37 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fa118449c01..32957bc52c9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2009-07-10 Robert Dewar + + * exp_util.adb: Minor code reorganization (use N_Short_Circuit) + + * exp_ch4.adb: Add ??? comment for conditional expressions on limited + types. + + * checks.adb (In_Declarative_Region_Of_Subprogram_Body): New procedure, + replaces Safe_To_Capture_In_Parameter_Value, and properly handles the + case of conditional expressions that may not be elaborated. + + * sem_util.adb (Safe_To_Capture_Value): Properly handle case of + conditional expression where we may not execute then then or else + branches. + 2009-07-10 Arnaud Charlet * i-cexten.ads (bool): New type. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 28131e58fe3..7f78a5ed5d0 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5253,31 +5253,31 @@ package body Checks is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); - function In_Declarative_Region_Of_Subprogram_Body return Boolean; - -- Determine whether node N, a reference to an *in* parameter, is - -- inside the declarative region of the current subprogram body. + function Safe_To_Capture_In_Parameter_Value return Boolean; + -- Determines if it is safe to capture Known_Non_Null status for an + -- the entity referenced by node N. The caller ensures that N is indeed + -- an entity name. It is safe to capture the non-null status for an IN + -- parameter when the reference occurs within a declaration that is sure + -- to be executed as part of the declarative region. procedure Mark_Non_Null; -- After installation of check, if the node in question is an entity -- name, then mark this entity as non-null if possible. - ---------------------------------------------- - -- In_Declarative_Region_Of_Subprogram_Body -- - ---------------------------------------------- - - function In_Declarative_Region_Of_Subprogram_Body return Boolean is + function Safe_To_Capture_In_Parameter_Value return Boolean is E : constant Entity_Id := Entity (N); S : constant Entity_Id := Current_Scope; S_Par : Node_Id; begin - pragma Assert (Ekind (E) = E_In_Parameter); + if Ekind (E) /= E_In_Parameter then + return False; + end if; -- Two initial context checks. We must be inside a subprogram body -- with declarations and reference must not appear in nested scopes. - if (Ekind (S) /= E_Function - and then Ekind (S) /= E_Procedure) + if (Ekind (S) /= E_Function and then Ekind (S) /= E_Procedure) or else Scope (E) /= S then return False; @@ -5303,6 +5303,26 @@ package body Checks is N_Decl := Empty; while Present (P) loop + -- If we have a short circuit form, and we are within the right + -- hand expression, we return false, since the right hand side + -- is not guaranteed to be elaborated. + + if Nkind (P) in N_Short_Circuit + and then N = Right_Opnd (P) + then + return False; + end if; + + -- Similarly, if we are in a conditional expression and not + -- part of the condition, then we return False, since neither + -- the THEN or ELSE expressions will always be elaborated. + + if Nkind (P) = N_Conditional_Expression + and then N /= First (Expressions (P)) + then + return False; + end if; + -- While traversing the parent chain, we find that N -- belongs to a statement, thus it may never appear in -- a declarative region. @@ -5313,6 +5333,8 @@ package body Checks is return False; end if; + -- If we are at a declaration, record it and exit + if Nkind (P) in N_Declaration and then Nkind (P) not in N_Subprogram_Specification then @@ -5329,7 +5351,7 @@ package body Checks is return List_Containing (N_Decl) = Declarations (S_Par); end; - end In_Declarative_Region_Of_Subprogram_Body; + end Safe_To_Capture_In_Parameter_Value; ------------------- -- Mark_Non_Null -- @@ -5350,13 +5372,14 @@ package body Checks is -- safe to capture the value, or in the case of an IN parameter, -- which is a constant, if the check we just installed is in the -- declarative region of the subprogram body. In this latter case, - -- a check is decisive for the rest of the body, since we know we - -- must complete all declarations before executing the body. + -- a check is decisive for the rest of the body if the expression + -- is sure to be elaborated, since we know we have to elaborate + -- all declarations before executing the body. + + -- Couldn't this always be part of Safe_To_Capture_Value ??? if Safe_To_Capture_Value (N, Entity (N)) - or else - (Ekind (Entity (N)) = E_In_Parameter - and then In_Declarative_Region_Of_Subprogram_Body) + or else Safe_To_Capture_In_Parameter_Value then Set_Is_Known_Non_Null (Entity (N)); end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7cfcaeed200..87ba03793d9 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3987,8 +3987,7 @@ package body Exp_Ch4 is else pragma Assert (Expr_Value_E (Right) = Standard_False); Remove_Side_Effects (Left); - Rewrite - (N, New_Occurrence_Of (Standard_False, Loc)); + Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); end if; end if; @@ -4028,6 +4027,21 @@ package body Exp_Ch4 is -- and replace the conditional expression by a reference to Cnn + -- ??? Note: this expansion is wrong for limited types, since it does + -- a copy of a limited value. The proper fix would be to do the + -- following expansion: + + -- Cnn : access typ; + -- if cond then + -- <> + -- Cnn := then-expr'Unrestricted_Access; + -- else + -- <> + -- Cnn := else-expr'Unrestricted_Access; + -- end if; + + -- and replace the conditional expresion by a reference to Cnn.all ??? + if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 97aa7655330..1de9c6e8396 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -255,9 +255,8 @@ package body Exp_Util is -- to reset its type, since Standard.Boolean is just fine, and -- such operations always do Adjust_Condition on their operands. - elsif KP in N_Op_Boolean - or else KP = N_And_Then - or else KP = N_Or_Else + elsif KP in N_Op_Boolean + or else KP in N_Short_Circuit or else KP = N_Op_Not then return; @@ -2305,7 +2304,7 @@ package body Exp_Util is -- Nothing special needs to be done for the left operand since -- in that case the actions are executed unconditionally. - when N_And_Then | N_Or_Else => + when N_Short_Circuit => if N = Right_Opnd (P) then -- We are now going to either append the actions to the @@ -4395,12 +4394,10 @@ package body Exp_Util is -- are side effect free. For this purpose binary operators -- include membership tests and short circuit forms - when N_Binary_Op | - N_Membership_Test | - N_And_Then | - N_Or_Else => + when N_Binary_Op | N_Membership_Test | N_Short_Circuit => return Side_Effect_Free (Left_Opnd (N)) - and then Side_Effect_Free (Right_Opnd (N)); + and then + Side_Effect_Free (Right_Opnd (N)); -- An explicit dereference is side effect free only if it is -- a side effect free prefixed reference. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7e9fea5924b..e7371b03c36 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7155,7 +7155,7 @@ package body Sem_Util is when N_Assignment_Statement => return N = Name (P); - -- Function call arguments are never lvalues + -- Function call arguments are never Lvalues when N_Function_Call => return False; @@ -7241,7 +7241,7 @@ package body Sem_Util is end; -- Test for appearing in a conversion that itself appears - -- in an lvalue context, since this should be an lvalue. + -- in an Lvalue context, since this should be an Lvalue. when N_Type_Conversion => return Known_To_Be_Assigned (P); @@ -7276,8 +7276,8 @@ package body Sem_Util is return N = Prefix (P) and then Name_Implies_Lvalue_Prefix (Attribute_Name (P)); - -- For an expanded name, the name is an lvalue if the expanded name - -- is an lvalue, but the prefix is never an lvalue, since it is just + -- For an expanded name, the name is an Lvalue if the expanded name + -- is an Lvalue, but the prefix is never an Lvalue, since it is just -- the scope where the name is found. when N_Expanded_Name => @@ -7304,7 +7304,7 @@ package body Sem_Util is end if; -- For an indexed component or slice, the index or slice bounds is - -- never an Lvalue. The prefix is an lvalue if the indexed component + -- never an Lvalue. The prefix is an Lvalue if the indexed component -- or slice is an Lvalue, except if it is an access type, where we -- have an implicit dereference. @@ -7414,7 +7414,7 @@ package body Sem_Util is end; -- Test for appearing in a conversion that itself appears in an - -- lvalue context, since this should be an lvalue. + -- Lvalue context, since this should be an Lvalue. when N_Type_Conversion => return May_Be_Lvalue (P); @@ -9819,10 +9819,12 @@ package body Sem_Util is P := Parent (N); while Present (P) loop - if Nkind (P) = N_If_Statement + if Nkind (P) = N_If_Statement or else Nkind (P) = N_Case_Statement - or else (Nkind (P) = N_And_Then and then Desc = Right_Opnd (P)) - or else (Nkind (P) = N_Or_Else and then Desc = Right_Opnd (P)) + or else (Nkind (P) in N_Short_Circuit + and then Desc = Right_Opnd (P)) + or else (Nkind (P) = N_Conditional_Expression + and then Desc /= First (Expressions (P))) or else Nkind (P) = N_Exception_Handler or else Nkind (P) = N_Selective_Accept or else Nkind (P) = N_Conditional_Entry_Call -- 2.30.2