aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/contracts.adb
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2022-03-15 13:20:24 -0700
committerPierre-Marie de Rodat <derodat@adacore.com>2022-05-17 08:25:41 +0000
commita08f366ae875ae70fba5014c94956cdbf7bf91db (patch)
treef9d2e24856f8ccc038738adf470396b9d0c30267 /gcc/ada/contracts.adb
parent8fc021c0988113e1fcc5ec026f2382b074894e95 (diff)
downloadgcc-a08f366ae875ae70fba5014c94956cdbf7bf91db.zip
gcc-a08f366ae875ae70fba5014c94956cdbf7bf91db.tar.gz
gcc-a08f366ae875ae70fba5014c94956cdbf7bf91db.tar.bz2
[Ada] Implement calls to abstract subprograms in class-wide pre/post-conditions
In some special cases involving class-wide pre/post conditions, Ada allows a non-dispatching call to an abstract function (which is usually illegal). Fix a bug in the implementation of Ada's rules about the run-time behavior of such a call. Thanks to Javier Miranda for producing this patch. gcc/ada/ * contracts.adb (Build_Call_Helper_Body): Improve handling of the case of a (legal) non-dispatching call to an abstract subprogram.
Diffstat (limited to 'gcc/ada/contracts.adb')
-rw-r--r--gcc/ada/contracts.adb14
1 files changed, 12 insertions, 2 deletions
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 7ce3cfa..9463642 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -3899,7 +3899,16 @@ package body Contracts is
Set_Corresponding_Body (Helper_Decl, Body_Id);
Set_Must_Override (Body_Spec, False);
- if Present (Class_Preconditions (Subp_Id)) then
+ if Present (Class_Preconditions (Subp_Id))
+ -- Evaluate the expression if we are building a dynamic helper
+ -- or we are building a static helper for a non-abstract tagged
+ -- type; for abstract tagged types the helper just returns True
+ -- since it is called by the indirect call wrapper (ICW).
+ and then
+ (Is_Dynamic
+ or else
+ not Is_Abstract_Type (Find_Dispatching_Type (Subp_Id)))
+ then
Return_Expr :=
Copy_And_Update_References (Class_Preconditions (Subp_Id));
@@ -3910,7 +3919,8 @@ package body Contracts is
-- enabled.
else
- pragma Assert (Present (Ignored_Class_Preconditions (Subp_Id)));
+ pragma Assert (Present (Ignored_Class_Preconditions (Subp_Id))
+ or else Is_Abstract_Type (Find_Dispatching_Type (Subp_Id)));
Return_Expr := New_Occurrence_Of (Standard_True, Loc);
end if;