aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/contracts.adb
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2021-03-19 16:01:40 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2021-06-18 04:36:52 -0400
commitc37c13e15e2a8e9f2716c29fe89cc2300d4457ce (patch)
tree163e5dbe21a342598bdd5276ac9eee6a18438b90 /gcc/ada/contracts.adb
parent4edcee5b2bf6ca2c0f7dcf5edcbe6daf715fc26a (diff)
downloadgcc-c37c13e15e2a8e9f2716c29fe89cc2300d4457ce.zip
gcc-c37c13e15e2a8e9f2716c29fe89cc2300d4457ce.tar.gz
gcc-c37c13e15e2a8e9f2716c29fe89cc2300d4457ce.tar.bz2
[Ada] Ada2020: AI12-0195 overriding class-wide pre/post conditions
gcc/ada/ * contracts.adb (Process_Spec_Postconditions): Add missing support for aliased subprograms and handle wrappers of class-wide pre/post conditions. (Process_Inherited_Preconditions): Add missing support for aliased subprograms and handle wrappers of class-wide pre/post conditions. * einfo.ads (Class_Wide_Clone): Fix typo. (Is_Class_Wide_Clone): Removed since it is not referenced. (Is_Wrapper): Documenting new flag. (LSP_Subprogram): Documenting new attribute. * exp_ch3.adb (Make_Controlling_Function_Wrappers): Decorate wrapper as Is_Wrapper and adjust call to Override_Dispatching_Operation. * freeze.adb (Build_Inherited_Condition_Pragmas): Fix typo in documentation. (Check_Inherited_Conditions): Handle LSP wrappers; ensure correct decoration of LSP wrappers. * gen_il-fields.ads (Is_Class_Wide_Clone): Removed. (Is_Wrapper): Added. (LSP_Subprogram): Added. * gen_il-gen-gen_entities.adb (Is_Class_Wide_Clone): Removed. (Is_Wrapper): Added. (LSP_Subprogram): Added. * gen_il-internals.adb (Image): Adding uppercase image of LSP_Subprogram. * sem_ch6.adb (New_Overloaded_Entity): Fix decoration of LSP wrappers. * sem_disp.ads (Override_Dispatching_Operation): Remove parameter Is_Wrapper; no longer needed. * sem_disp.adb (Check_Dispatching_Operation): Adjust assertion. (Override_Dispatching_Operation): Remove parameter Is_Wrapper; no longer needed. * treepr.adb (Image): Adding uppercase image of LSP_Subprogram.
Diffstat (limited to 'gcc/ada/contracts.adb')
-rw-r--r--gcc/ada/contracts.adb32
1 files changed, 30 insertions, 2 deletions
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index f31d265..d096cbb 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2610,7 +2610,21 @@ package body Contracts is
for Index in Subps'Range loop
Subp_Id := Subps (Index);
- Items := Contract (Subp_Id);
+
+ if Present (Alias (Subp_Id)) then
+ Subp_Id := Ultimate_Alias (Subp_Id);
+ end if;
+
+ -- Wrappers of class-wide pre/post conditions reference the
+ -- parent primitive that has the inherited contract.
+
+ if Is_Wrapper (Subp_Id)
+ and then Present (LSP_Subprogram (Subp_Id))
+ then
+ Subp_Id := LSP_Subprogram (Subp_Id);
+ end if;
+
+ Items := Contract (Subp_Id);
if Present (Items) then
Prag := Pre_Post_Conditions (Items);
@@ -2892,7 +2906,21 @@ package body Contracts is
for Index in Subps'Range loop
Subp_Id := Subps (Index);
- Items := Contract (Subp_Id);
+
+ if Present (Alias (Subp_Id)) then
+ Subp_Id := Ultimate_Alias (Subp_Id);
+ end if;
+
+ -- Wrappers of class-wide pre/post conditions reference the
+ -- parent primitive that has the inherited contract.
+
+ if Is_Wrapper (Subp_Id)
+ and then Present (LSP_Subprogram (Subp_Id))
+ then
+ Subp_Id := LSP_Subprogram (Subp_Id);
+ end if;
+
+ Items := Contract (Subp_Id);
if Present (Items) then
Prag := Pre_Post_Conditions (Items);