[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.

diff --git a/gcc/ada/contracts.ads b/gcc/ada/contracts.ads
index adbb0e6eb67a0fd203c76441496b9cae7057bfef..5178373bff39278bd688566d42e356b35ec09c22 100644 (file)
--- 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 7d90f51224596af37e9c5aa0846522c8822bee63..ca0ffe39c25284a829f6f36c7a7b5f87d28d9128 100644 (file)
--- 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));