aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorYannick Moy <moy@adacore.com>2023-06-08 09:12:25 +0000
committerMarc Poulhiès <poulhies@adacore.com>2023-06-20 09:30:50 +0200
commit8912b95779dd233fb3a8c8b4dda033ed7b50be31 (patch)
treee8636ef3eba23725e15b2a6016ebf43c1a49031c /gcc/ada
parentf1c15fe3f054d453f94e1412ec5bcb2c1e7205e8 (diff)
downloadgcc-8912b95779dd233fb3a8c8b4dda033ed7b50be31.zip
gcc-8912b95779dd233fb3a8c8b4dda033ed7b50be31.tar.gz
gcc-8912b95779dd233fb3a8c8b4dda033ed7b50be31.tar.bz2
ada: Do not issue warning on postcondition in some cases
Warning on suspicious postcondition is not relevant if contract Exceptional_Cases is present, or if contract Always_Terminates is present with a non-statically True value, as in those cases the postcondition can be used to indicate constraints on those pre-state for which the subprogram might terminate normally. gcc/ada/ * sem_util.adb (Check_Result_And_Post_State): Do not warn in cases where the warning could be spurious.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/sem_util.adb32
1 files changed, 32 insertions, 0 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3a64047d..1729a2a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4566,6 +4566,38 @@ package body Sem_Util is
elsif No (Items) then
return;
+
+ -- If the subprogram has a contract Exceptional_Cases, it is often
+ -- useful to refer only to the pre-state in the postcondition, to
+ -- indicate when the subprogram might terminate normally.
+
+ elsif Present (Get_Pragma (Subp_Id, Pragma_Exceptional_Cases)) then
+ return;
+
+ -- Same if the subprogram has a contract Always_Terminates => Cond,
+ -- where Cond is not syntactically True.
+
+ else
+ declare
+ Prag : constant Node_Id :=
+ Get_Pragma (Subp_Id, Pragma_Always_Terminates);
+ begin
+ if Present (Prag)
+ and then Present (Pragma_Argument_Associations (Prag))
+ then
+ declare
+ Cond : constant Node_Id :=
+ Get_Pragma_Arg
+ (First (Pragma_Argument_Associations (Prag)));
+ begin
+ if not Compile_Time_Known_Value (Cond)
+ or else not Is_True (Expr_Value (Cond))
+ then
+ return;
+ end if;
+ end;
+ end if;
+ end;
end if;
-- Examine all postconditions for attribute 'Result and a post-state