From 55a11c7e345dd06d6975fe8f4dc0e11ecbb581ff Mon Sep 17 00:00:00 2001
From: Steve Baird <baird@adacore.com>
Date: Mon, 4 Apr 2022 17:52:11 -0700
Subject: [Ada] Fix bug in handling of Predicate_Failure aspect

The run-time behavior of the Ada 2022 Predicate_Failure aspect was
incorrectly implemented. This could cause incorrect exception messages
at execution time in the case of a predicate check failure, as
demonstrated by ACATS test C324006. In addition, a new attribute
(Predicate_Expression) is defined in order to improve the FE/SPARK
interface.

gcc/ada/

	* einfo-utils.ads, einfo-utils.adb: Delete Predicate_Function_M
	function and Set_Predicate_Function_M procedure.
	* einfo.ads: Delete comments for Is_Predicate_Function_M and
	Predicate_Function_M functions. Add comment for new
	Predicate_Expression function. Update comment describing
	predicate functions.
	* exp_util.ads, exp_util.adb (Make_Predicate_Call): Replace Mem
	formal parameter with Static_Mem and Dynamic_Mem formals.
	(Make_Predicate_Check): Delete Add_Failure_Expression and call
	to it.
	* exp_ch4.adb (Expand_N_In.Predicate_Check): Update
	Make_Predicate_Call call to match profile change.
	* gen_il-fields.ads: Delete Is_Predicate_Function_M field, add
	Predicate_Expression field.
	* gen_il-gen-gen_entities.adb: Delete Is_Predicate_Function_M
	use, add Predicate_Expression use.
	* sem_ch13.adb (Build_Predicate_Functions): Rename as singular,
	not plural; we no longer build a Predicate_M function. Delete
	Predicate_M references. Add new Boolean parameter for predicate
	functions when needed. Restructure body of generated predicate
	functions to implement required Predicate_Failure behavior and
	to set new Predicate_Expression attribute. Remove special
	treatment of raise expressions within predicate expressions.
	* sem_util.ads (Predicate_Failure_Expression,
	Predicate_Function_Needs_Membership_Parameter): New functions.
	* sem_util.adb (Is_Current_Instance): Fix bugs which caused
	wrong result.
	(Is_Current_Instance_Reference_In_Type_Aspect): Delete
	Is_Predicate_Function_M reference.
	(Predicate_Failure_Expression): New function.
	(Propagate_Predicate_Attributes): Delete Is_Predicate_Function_M
	references.
---
 gcc/ada/einfo-utils.adb | 84 -------------------------------------------------
 1 file changed, 84 deletions(-)

(limited to 'gcc/ada/einfo-utils.adb')

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index cf61ec7..48a1bce 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -2390,53 +2390,6 @@ package body Einfo.Utils is
       return Empty;
    end Predicate_Function;
 
-   --------------------------
-   -- Predicate_Function_M --
-   --------------------------
-
-   function Predicate_Function_M (Id : E) return E is
-      Subp_Elmt : Elmt_Id;
-      Subp_Id   : Entity_Id;
-      Subps     : Elist_Id;
-      Typ       : Entity_Id;
-
-   begin
-      pragma Assert (Is_Type (Id));
-
-      --  If type is private and has a completion, predicate may be defined on
-      --  the full view.
-
-      if Is_Private_Type (Id)
-         and then
-           (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
-         and then Present (Full_View (Id))
-      then
-         Typ := Full_View (Id);
-
-      else
-         Typ := Id;
-      end if;
-
-      Subps := Subprograms_For_Type (Typ);
-
-      if Present (Subps) then
-         Subp_Elmt := First_Elmt (Subps);
-         while Present (Subp_Elmt) loop
-            Subp_Id := Node (Subp_Elmt);
-
-            if Ekind (Subp_Id) = E_Function
-              and then Is_Predicate_Function_M (Subp_Id)
-            then
-               return Subp_Id;
-            end if;
-
-            Next_Elmt (Subp_Elmt);
-         end loop;
-      end if;
-
-      return Empty;
-   end Predicate_Function_M;
-
    -------------------------
    -- Present_In_Rep_Item --
    -------------------------
@@ -2879,43 +2832,6 @@ package body Einfo.Utils is
       end loop;
    end Set_Predicate_Function;
 
-   ------------------------------
-   -- Set_Predicate_Function_M --
-   ------------------------------
-
-   procedure Set_Predicate_Function_M (Id : E; V : E) is
-      Subp_Elmt : Elmt_Id;
-      Subp_Id   : Entity_Id;
-      Subps     : Elist_Id;
-
-   begin
-      pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
-
-      Subps := Subprograms_For_Type (Id);
-
-      if No (Subps) then
-         Subps := New_Elmt_List;
-         Set_Subprograms_For_Type (Id, Subps);
-      end if;
-
-      Subp_Elmt := First_Elmt (Subps);
-      Prepend_Elmt (V, Subps);
-
-      --  Check for a duplicate predication function
-
-      while Present (Subp_Elmt) loop
-         Subp_Id := Node (Subp_Elmt);
-
-         if Ekind (Subp_Id) = E_Function
-           and then Is_Predicate_Function_M (Subp_Id)
-         then
-            raise Program_Error;
-         end if;
-
-         Next_Elmt (Subp_Elmt);
-      end loop;
-   end Set_Predicate_Function_M;
-
    -----------------
    -- Size_Clause --
    -----------------
-- 
cgit v1.1