and then Is_Discrete_Type (Etype (DS))
then
declare
- L : Node_Id;
- H : Node_Id;
+ L : Node_Id;
+ H : Node_Id;
+ Null_Range : Boolean := False;
begin
if Nkind (DS) = N_Range then
-- null range may be detected statically.
if Compile_Time_Compare (L, H, Assume_Valid => True) = GT then
+ if Compile_Time_Compare (L, H, Assume_Valid => False) = GT then
+ -- Since we know the range of the loop is always null,
+ -- set the appropriate flag to remove the loop entirely
+ -- during expansion.
+
+ Set_Is_Null_Loop (Loop_Nod);
+ Null_Range := True;
+ end if;
-- Suppress the warning if inside a generic template or
-- instance, since in practice they tend to be dubious in these
-- Specialize msg if invalid values could make the loop
-- non-null after all.
- if Compile_Time_Compare
- (L, H, Assume_Valid => False) = GT
- then
- -- Since we know the range of the loop is null, set the
- -- appropriate flag to remove the loop entirely during
- -- expansion.
-
- Set_Is_Null_Loop (Loop_Nod);
-
+ if Null_Range then
if Comes_From_Source (N) then
Error_Msg_N
("??loop range is null, loop will not execute", DS);
end if;
- -- Here is where the loop could execute because of
- -- invalid values, so issue appropriate message and in
- -- this case we do not set the Is_Null_Loop flag since
- -- the loop may execute.
+ -- Here is where the loop could execute because of
+ -- invalid values, so issue appropriate message.
elsif Comes_From_Source (N) then
Error_Msg_N
Analyze_Statements (Statements (N));
end if;
+ -- If the loop has no side effects, mark it for removal.
+
+ if Side_Effect_Free_Loop (N) then
+ Set_Is_Null_Loop (N);
+ end if;
+
-- When the iteration scheme of a loop contains attribute 'Loop_Entry,
-- the loop is transformed into a conditional block. Retrieve the loop.
Node := First (L);
loop
- if Nkind (Node) /= N_Null_Statement then
+ if not Nkind_In (Node, N_Null_Statement, N_Call_Marker) then
return True;
end if;
return False;
end Has_Non_Null_Statements;
+ ---------------------------------
+ -- Side_Effect_Free_Statements --
+ ---------------------------------
+
+ function Side_Effect_Free_Statements (L : List_Id) return Boolean is
+ Node : Node_Id;
+
+ begin
+ if Is_Non_Empty_List (L) then
+ Node := First (L);
+
+ loop
+ case Nkind (Node) is
+ when N_Null_Statement | N_Call_Marker | N_Raise_xxx_Error =>
+ null;
+ when N_Object_Declaration =>
+ if Present (Expression (Node))
+ and then not Side_Effect_Free (Expression (Node))
+ then
+ return False;
+ end if;
+
+ when others =>
+ return False;
+ end case;
+
+ Next (Node);
+ exit when Node = Empty;
+ end loop;
+ end if;
+
+ return True;
+ end Side_Effect_Free_Statements;
+
+ ---------------------------
+ -- Side_Effect_Free_Loop --
+ ---------------------------
+
+ function Side_Effect_Free_Loop (N : Node_Id) return Boolean is
+ Scheme : Node_Id;
+ Spec : Node_Id;
+ Subt : Node_Id;
+
+ begin
+ -- If this is not a loop (e.g. because the loop has been rewritten),
+ -- then return false.
+
+ if Nkind (N) /= N_Loop_Statement then
+ return False;
+ end if;
+
+ -- First check the statements
+
+ if Side_Effect_Free_Statements (Statements (N)) then
+
+ -- Then check the loop condition/indexes
+
+ if Present (Iteration_Scheme (N)) then
+ Scheme := Iteration_Scheme (N);
+
+ if Present (Condition (Scheme))
+ or else Present (Iterator_Specification (Scheme))
+ then
+ return False;
+ elsif Present (Loop_Parameter_Specification (Scheme)) then
+ Spec := Loop_Parameter_Specification (Scheme);
+ Subt := Discrete_Subtype_Definition (Spec);
+
+ if Present (Subt) then
+ if Nkind (Subt) = N_Range then
+ return Side_Effect_Free (Low_Bound (Subt))
+ and then Side_Effect_Free (High_Bound (Subt));
+ else
+ -- subtype indication
+
+ return True;
+ end if;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ return False;
+ end Side_Effect_Free_Loop;
+
----------------------------------
-- Has_Non_Trivial_Precondition --
----------------------------------
function Has_Non_Null_Statements (L : List_Id) return Boolean;
-- Return True if L has non-null statements
+ function Side_Effect_Free_Statements (L : List_Id) return Boolean;
+ -- Return True if L has no statements with side effects
+
+ function Side_Effect_Free_Loop (N : Node_Id) return Boolean;
+ -- Return True if the loop has no side effect and can therefore be
+ -- marked for removal. Return False if N is not a N_Loop_Statement.
+
function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
-- Predicate to determine whether a controlled type has a user-defined
-- Initialize primitive (and, in Ada 2012, whether that primitive is
projects / thirdparty / gcc.git / commitdiff
