[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.
This commit is contained in:
parent
d409061404
commit
c30e5ab027
2 changed files with 40 additions and 0 deletions
|
@ -226,6 +226,39 @@ package Contracts is
|
||||||
-- overrides an inherited class-wide precondition (see AI12-0195-1).
|
-- overrides an inherited class-wide precondition (see AI12-0195-1).
|
||||||
-- Late_Overriding enables special handling required for late-overriding
|
-- Late_Overriding enables special handling required for late-overriding
|
||||||
-- subprograms.
|
-- 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);
|
procedure Merge_Class_Conditions (Spec_Id : Entity_Id);
|
||||||
-- Merge and preanalyze all class-wide conditions of Spec_Id (class-wide
|
-- Merge and preanalyze all class-wide conditions of Spec_Id (class-wide
|
||||||
|
|
|
@ -1619,6 +1619,13 @@ package body Freeze is
|
||||||
DTW_Spec := Build_Overriding_Spec (Par_Prim, R);
|
DTW_Spec := Build_Overriding_Spec (Par_Prim, R);
|
||||||
DTW_Id := Defining_Entity (DTW_Spec);
|
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
|
-- Add minimal decoration of fields
|
||||||
|
|
||||||
Mutate_Ekind (DTW_Id, Ekind (Par_Prim));
|
Mutate_Ekind (DTW_Id, Ekind (Par_Prim));
|
||||||
|
|
Loading…
Add table
Reference in a new issue