[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:
Javier Miranda 2022-03-18 19:28:52 +00:00 committed by Pierre-Marie de Rodat
parent d409061404
commit c30e5ab027
2 changed files with 40 additions and 0 deletions

View file

@ -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

View file

@ -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));