diff options
author | Javier Miranda <miranda@adacore.com> | 2021-03-19 16:01:40 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-06-18 04:36:52 -0400 |
commit | c37c13e15e2a8e9f2716c29fe89cc2300d4457ce (patch) | |
tree | 163e5dbe21a342598bdd5276ac9eee6a18438b90 /gcc/ada/contracts.adb | |
parent | 4edcee5b2bf6ca2c0f7dcf5edcbe6daf715fc26a (diff) | |
download | gcc-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.adb | 32 |
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); |