In cases where GNAT did not detect the possibility of an infinite loop, it now
issues a warning. For example, on the following code:
$ gcc -c bad.adb
bad.adb:9:13: warning: variable "Cur" is not modified in loop body
bad.adb:9:13: warning: possible infinite loop
1. package body Bad is
2. procedure P (Y : Integer) is
3. begin
4. null;
5. end P;
6. procedure Q (X : Integer) is
7. Cur : Integer := X;
8. begin
9. while Cur /= 0 loop
10. P (Cur);
11. end loop;
12. end Q;
13. end Bad;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-10-01 Yannick Moy <m...@adacore.com>
* sem_warn.adb (Check_Infinite_Loop_Warning/Test_Ref): Improve
the detection of modifications to the loop variable by noting
that, if the type of variable is elementary and the condition
does not contain a function call, then the condition cannot be
modified by side-effects from a procedure call.
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 191890)
+++ sem_warn.adb (working copy)
@@ -472,32 +472,41 @@
return Abandon;
end if;
- -- If we appear in the context of a procedure call, then also
- -- abandon, since there may be issues of non-visible side
- -- effects going on in the call.
+ -- If the condition contains a function call, we consider it may
+ -- be modified by side-effects from a procedure call. Otherwise,
+ -- we consider the condition may not be modified, although that
+ -- might happen if Variable is itself a by-reference parameter,
+ -- and the procedure called modifies the global object referred to
+ -- by Variable, but we actually prefer to issue a warning in this
+ -- odd case. Note that the case where the procedure called has
+ -- visibility over Variable is treated in another case below.
- declare
- P : Node_Id;
+ if Function_Call_Found then
+ declare
+ P : Node_Id;
- begin
- P := N;
- loop
- P := Parent (P);
- exit when P = Loop_Statement;
+ begin
+ P := N;
+ loop
+ P := Parent (P);
+ exit when P = Loop_Statement;
- -- Abandon if at procedure call, or something strange is
- -- going on (perhaps a node with no parent that should
- -- have one but does not?) As always, for a warning we
- -- prefer to just abandon the warning than get into the
- -- business of complaining about the tree structure here!
+ -- Abandon if at procedure call, or something strange is
+ -- going on (perhaps a node with no parent that should
+ -- have one but does not?) As always, for a warning we
+ -- prefer to just abandon the warning than get into the
+ -- business of complaining about the tree structure here!
- if No (P) or else Nkind (P) = N_Procedure_Call_Statement then
- return Abandon;
- end if;
- end loop;
- end;
+ if No (P)
+ or else Nkind (P) = N_Procedure_Call_Statement
+ then
+ return Abandon;
+ end if;
+ end loop;
+ end;
+ end if;
- -- Reference to variable renaming variable in question
+ -- Reference to variable renaming variable in question
elsif Is_Entity_Name (N)
and then Present (Entity (N))
@@ -509,7 +518,7 @@
then
return Abandon;
- -- Call to subprogram
+ -- Call to subprogram
elsif Nkind (N) in N_Subprogram_Call then
