Skip to content

R
riscv-gcc-1
Commit ac7120ce by Robert Dewar Committed by Arnaud Charlet
Options

exp_util.adb: Minor code reorganization (use N_Short_Circuit) 

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.

From-SVN: r149468
parent 514d0fc5
Showing with 88 additions and 37 deletions
gcc/ada/ChangeLog
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.
......
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;
......
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
-- <<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'));
......
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.
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment