+2009-07-10 Robert Dewar <dewar@adacore.com>
+
+ * 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 <charlet@adacore.com>
* i-cexten.ads (bool): New type.
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;
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.
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
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 --
-- 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;
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;
-- 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
+ -- <<then actions>>
+ -- Cnn := then-expr'Unrestricted_Access;
+ -- else
+ -- <<else actions>>
+ -- 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'));
-- 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;
-- 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
-- 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.
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;
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);
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 =>
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.
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);
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
projects / gcc.git / commitdiff