diff options
| author | Javier Miranda <miranda@adacore.com> | 2022-03-18 19:28:52 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-05-17 08:25:41 +0000 |
| commit | c30e5ab027a59a2ffcf7fb2d093ce2b64de712eb (patch) | |
| tree | 538497cb00998337b189efcfa00a810dbda7b7b1 /gcc | |
| parent | d4090614041c7803373a5064dfb82fdf6017971d (diff) | |
| download | gcc-c30e5ab027a59a2ffcf7fb2d093ce2b64de712eb.zip gcc-c30e5ab027a59a2ffcf7fb2d093ce2b64de712eb.tar.gz gcc-c30e5ab027a59a2ffcf7fb2d093ce2b64de712eb.tar.bz2 | |
[Ada] Spurious error on subprogram with class-wide preconditions
gcc/ada/
* freeze.adb (Build_DTW_Spec): Do not inherit the not-overriding
indicator because the DTW wrapper overrides its wrapped
subprogram.
* contracts.ads (Make_Class_Precondition_Subps): Adding
documentation.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/contracts.ads | 33 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 7 |
2 files changed, 40 insertions, 0 deletions
diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads index adbb0e6..5178373 100644 --- a/gcc/ada/contracts.ads +++ b/gcc/ada/contracts.ads @@ -226,6 +226,39 @@ package Contracts is -- overrides an inherited class-wide precondition (see AI12-0195-1). -- Late_Overriding enables special handling required for late-overriding -- subprograms. + -- + -- For example, if we have a subprogram with the following profile: + -- + -- procedure Prim (Obj : TagTyp; <additional formals>) + -- with Pre'Class => F1 (Obj) and F2(Obj) + -- + -- We build the following helper that evaluates statically the class-wide + -- precondition: + -- + -- function PrimSP (Obj : TagTyp) return Boolean is + -- begin + -- return F1 (Obj) and F2(Obj); + -- end PrimSP; + -- + -- ... and the following helper that evaluates dynamically the class-wide + -- precondition: + -- + -- function PrimDP (Obj : TagTyp'Class; ...) return Boolean is + -- begin + -- return F1 (Obj) and F2(Obj); + -- end PrimSP; + -- + -- ... and the following indirect-call wrapper (ICW) that is used by the + -- code generated by the compiler for indirect calls: + -- + -- procedure PrimICW (Obj : TagTyp; <additional formals> is + -- begin + -- if not PrimSP (Obj) then + -- $raise_assert_failure ("failed precondition in call at ..."); + -- end if; + -- + -- Prim (Obj, ...); + -- end Prim; procedure Merge_Class_Conditions (Spec_Id : Entity_Id); -- Merge and preanalyze all class-wide conditions of Spec_Id (class-wide diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7d90f51..ca0ffe3 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1619,6 +1619,13 @@ package body Freeze is DTW_Spec := Build_Overriding_Spec (Par_Prim, R); DTW_Id := Defining_Entity (DTW_Spec); + -- Clear the not-overriding indicator since the DTW wrapper overrides + -- its wrapped subprogram; required because if present in the parent + -- primitive, given that Build_Overriding_Spec inherits it, we report + -- spurious errors. + + Set_Must_Not_Override (DTW_Spec, False); + -- Add minimal decoration of fields Mutate_Ekind (DTW_Id, Ekind (Par_Prim)); |