[multiple changes]

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* atree.h: Add declarations for Flag255-Flag289 Fix declaration
	of Field30 (was wrong, but no effect, since not yet referenced by
	back end) Add declarations for Field31-Field35 Add declarations
	for Node31-Node35.
	* einfo.ads, einfo.adb (Has_Invariants): No longer applies to
	procedures.
	(Has_Predicates): No longer applies to functions.
	(Is_Predicate_Function): New flag.
	(Is_Predicate_Function_M): New flag.
	(Is_Invariant_Procedure): New flag.
	(Predicate_Function_M): New function.
	(Set_Predicate_Function_M): New procedure.
	* exp_ch11.adb (Expand_N_Raise_Expression): Take care of special
	case of appearing in predicate used for membership test.
	* exp_ch3.adb (Insert_Component_Invariant_Checks): Set
	Is_Invariant_Procedure flag.
	* exp_ch4.adb (Expand_Op_In): Call special predicate function
	that takes care of raise_expression nodes in the predicate.
	* exp_util.ads, exp_util.adb (Make_Predicate_Call): Add argument Mem for
	membership case.
	* sem_ch13.adb (Build_Predicate_Functions): New name for
	Build_Predicate_Function.  Major rewrite to take care of raise
	expression in predicate for membership tests.
	* sem_res.adb (Resolve_Actuals): Include both predicate functions
	in defense against infinite predicate function loops.
	* sinfo.ads, sinfo.adb (Convert_To_Return_False): New flag.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Minor reformatting.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb: Generate reference for component of anonymous
	access type.

From-SVN: r197766

15 files changed, 650 insertions, 168 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3582e9f..d93f15c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,43 @@
 2013-04-11  Robert Dewar  <dewar@adacore.com>
 
+	* atree.h: Add declarations for Flag255-Flag289 Fix declaration
+	of Field30 (was wrong, but no effect, since not yet referenced by
+	back end) Add declarations for Field31-Field35 Add declarations
+	for Node31-Node35.
+	* einfo.ads, einfo.adb (Has_Invariants): No longer applies to
+	procedures.
+	(Has_Predicates): No longer applies to functions.
+	(Is_Predicate_Function): New flag.
+	(Is_Predicate_Function_M): New flag.
+	(Is_Invariant_Procedure): New flag.
+	(Predicate_Function_M): New function.
+	(Set_Predicate_Function_M): New procedure.
+	* exp_ch11.adb (Expand_N_Raise_Expression): Take care of special
+	case of appearing in predicate used for membership test.
+	* exp_ch3.adb (Insert_Component_Invariant_Checks): Set
+	Is_Invariant_Procedure flag.
+	* exp_ch4.adb (Expand_Op_In): Call special predicate function
+	that takes care of raise_expression nodes in the predicate.
+	* exp_util.ads, exp_util.adb (Make_Predicate_Call): Add argument Mem for
+	membership case.
+	* sem_ch13.adb (Build_Predicate_Functions): New name for
+	Build_Predicate_Function.  Major rewrite to take care of raise
+	expression in predicate for membership tests.
+	* sem_res.adb (Resolve_Actuals): Include both predicate functions
+	in defense against infinite predicate function loops.
+	* sinfo.ads, sinfo.adb (Convert_To_Return_False): New flag.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb: Minor reformatting.
+
+2013-04-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-xref.adb: Generate reference for component of anonymous
+	access type.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
 	* stand.ads: Minor reformatting.
 
 2013-04-11  Matthew Heaney  <heaney@adacore.com>
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index 7d88c4d..c9fd5e0 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2013, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -259,6 +259,45 @@ struct Flag_Word4
   Boolean      flag215	    :  1;
 };
 
+/* Structure used for extra flags in sixth component overlaying Field12 */
+struct Flag_Word5
+{
+  Boolean      flag255	    :  1;
+  Boolean      flag256	    :  1;
+  Boolean      flag257	    :  1;
+  Boolean      flag258	    :  1;
+  Boolean      flag259	    :  1;
+  Boolean      flag260	    :  1;
+  Boolean      flag261	    :  1;
+  Boolean      flag262	    :  1;
+
+  Boolean      flag263	    :  1;
+  Boolean      flag264	    :  1;
+  Boolean      flag265	    :  1;
+  Boolean      flag266	    :  1;
+  Boolean      flag267	    :  1;
+  Boolean      flag268	    :  1;
+  Boolean      flag269	    :  1;
+  Boolean      flag270	    :  1;
+
+  Boolean      flag271	    :  1;
+  Boolean      flag272	    :  1;
+  Boolean      flag273	    :  1;
+  Boolean      flag274	    :  1;
+  Boolean      flag275	    :  1;
+  Boolean      flag276	    :  1;
+  Boolean      flag277	    :  1;
+  Boolean      flag278	    :  1;
+
+  Boolean      flag279      :  1;
+  Boolean      flag280	    :  1;
+  Boolean      flag281	    :  1;
+  Boolean      flag282	    :  1;
+  Boolean      flag283	    :  1;
+  Boolean      flag284	    :  1;
+  Boolean      flag285	    :  1;
+  Boolean      flag286	    :  1;
+};
 struct Non_Extended
 {
   Source_Ptr   sloc;
@@ -290,6 +329,7 @@ struct Extended
       struct   Flag_Word fw;
       struct   Flag_Word2 fw2;
       struct   Flag_Word4 fw4;
+      struct   Flag_Word5 fw5;
     } U;
 };
 
@@ -387,7 +427,12 @@ extern Node_Id Current_Error_Node;
 #define Field27(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9)
 #define Field28(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field10)
 #define Field29(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.field11)
-#define Field30(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6)
+#define Field30(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field6)
+#define Field31(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field7)
+#define Field32(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field8)
+#define Field33(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field9)
+#define Field34(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field10)
+#define Field35(N)    (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.X.field11)
 
 #define Node1(N)      Field1  (N)
 #define Node2(N)      Field2  (N)
@@ -419,6 +464,12 @@ extern Node_Id Current_Error_Node;
 #define Node28(N)     Field28 (N)
 #define Node29(N)     Field29 (N)
 #define Node30(N)     Field30 (N)
+#define Node31(N)     Field31 (N)
+#define Node32(N)     Field32 (N)
+#define Node33(N)     Field33 (N)
+#define Node34(N)     Field34 (N)
+#define Node35(N)     Field35 (N)
+#define Node36(N)     Field36 (N)
 
 #define List1(N)      Field1  (N)
 #define List2(N)      Field2  (N)
@@ -742,6 +793,39 @@ extern Node_Id Current_Error_Node;
 #define Flag253(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag71)
 #define Flag254(N)     (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag72)
 
+#define Flag255(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag255)
+#define Flag256(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag256)
+#define Flag257(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag257)
+#define Flag258(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag258)
+#define Flag259(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag259)
+#define Flag260(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag260)
+#define Flag261(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag261)
+#define Flag262(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag262)
+#define Flag263(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag263)
+#define Flag264(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag264)
+#define Flag265(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag265)
+#define Flag266(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag266)
+#define Flag267(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag267)
+#define Flag268(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag268)
+#define Flag269(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag269)
+#define Flag270(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag270)
+#define Flag271(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag271)
+#define Flag272(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag272)
+#define Flag273(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag273)
+#define Flag274(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag274)
+#define Flag275(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag275)
+#define Flag276(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag276)
+#define Flag277(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag277)
+#define Flag278(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag278)
+#define Flag279(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag279)
+#define Flag280(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag280)
+#define Flag281(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag281)
+#define Flag282(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag282)
+#define Flag283(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag283)
+#define Flag284(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag284)
+#define Flag285(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag285)
+#define Flag286(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag286)
+
 #ifdef __cplusplus
 }
 #endif
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 934dd27..b81a1c6 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -542,10 +542,10 @@ package body Einfo is
    --    Is_Processed_Transient          Flag252
    --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
+   --    Is_Predicate_Function           Flag255
+   --    Is_Predicate_Function_M         Flag256
+   --    Is_Invariant_Procedure          Flag257
 
-   --    (unused)                        Flag255
-   --    (unused)                        Flag256
-   --    (unused)                        Flag257
    --    (unused)                        Flag258
    --    (unused)                        Flag259
    --    (unused)                        Flag260
@@ -578,40 +578,8 @@ package body Einfo is
    --    (unused)                        Flag284
    --    (unused)                        Flag285
    --    (unused)                        Flag286
-   --    (unused)                        Flag287
-   --    (unused)                        Flag288
-   --    (unused)                        Flag289
-   --    (unused)                        Flag290
-
-   --    (unused)                        Flag291
-   --    (unused)                        Flag292
-   --    (unused)                        Flag293
-   --    (unused)                        Flag294
-   --    (unused)                        Flag295
-   --    (unused)                        Flag296
-   --    (unused)                        Flag297
-   --    (unused)                        Flag298
-   --    (unused)                        Flag299
-   --    (unused)                        Flag300
-
-   --    (unused)                        Flag301
-   --    (unused)                        Flag302
-   --    (unused)                        Flag303
-   --    (unused)                        Flag304
-   --    (unused)                        Flag305
-   --    (unused)                        Flag306
-   --    (unused)                        Flag307
-   --    (unused)                        Flag308
-   --    (unused)                        Flag309
-   --    (unused)                        Flag310
-
-   --    (unused)                        Flag311
-   --    (unused)                        Flag312
-   --    (unused)                        Flag313
-   --    (unused)                        Flag314
-   --    (unused)                        Flag315
-   --    (unused)                        Flag316
-   --    (unused)                        Flag317
+
+   --  Note: Flag287-317 are defined in atree.ads/adb, but not yet in atree.h
 
    -----------------------
    -- Local subprograms --
@@ -1488,9 +1456,7 @@ package body Einfo is
 
    function Has_Invariants (Id : E) return B is
    begin
-      pragma Assert (Is_Type (Id)
-        or else Ekind (Id) = E_Procedure
-        or else Ekind (Id) = E_Generic_Procedure);
+      pragma Assert (Is_Type (Id));
       return Flag232 (Id);
    end Has_Invariants;
 
@@ -1614,6 +1580,7 @@ package body Einfo is
 
    function Has_Predicates (Id : E) return B is
    begin
+      pragma Assert (Is_Type (Id));
       return Flag250 (Id);
    end Has_Predicates;
 
@@ -2076,6 +2043,12 @@ package body Einfo is
       return Flag64 (Id);
    end Is_Intrinsic_Subprogram;
 
+   function Is_Invariant_Procedure (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      return Flag257 (Id);
+   end Is_Invariant_Procedure;
+
    function Is_Itype (Id : E) return B is
    begin
       return Flag91 (Id);
@@ -2167,6 +2140,18 @@ package body Einfo is
       return Flag9 (Id);
    end Is_Potentially_Use_Visible;
 
+   function Is_Predicate_Function (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      return Flag255 (Id);
+   end Is_Predicate_Function;
+
+   function Is_Predicate_Function_M (Id : E) return B is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      return Flag256 (Id);
+   end Is_Predicate_Function_M;
+
    function Is_Preelaborated (Id : E) return B is
    begin
       return Flag59 (Id);
@@ -4037,9 +4022,7 @@ package body Einfo is
 
    procedure Set_Has_Invariants (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Type (Id)
-        or else Ekind (Id) = E_Procedure
-        or else Ekind (Id) = E_Void);
+      pragma Assert (Is_Type (Id));
       Set_Flag232 (Id, V);
    end Set_Has_Invariants;
 
@@ -4172,6 +4155,7 @@ package body Einfo is
 
    procedure Set_Has_Predicates (Id : E; V : B := True) is
    begin
+      pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
       Set_Flag250 (Id, V);
    end Set_Has_Predicates;
 
@@ -4658,6 +4642,12 @@ package body Einfo is
       Set_Flag64 (Id, V);
    end Set_Is_Intrinsic_Subprogram;
 
+   procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      Set_Flag257 (Id, V);
+   end Set_Is_Invariant_Procedure;
+
    procedure Set_Is_Itype (Id : E; V : B := True) is
    begin
       Set_Flag91 (Id, V);
@@ -4752,6 +4742,18 @@ package body Einfo is
       Set_Flag9 (Id, V);
    end Set_Is_Potentially_Use_Visible;
 
+   procedure Set_Is_Predicate_Function (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      Set_Flag255 (Id, V);
+   end Set_Is_Predicate_Function;
+
+   procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+      Set_Flag256 (Id, V);
+   end Set_Is_Predicate_Function_M;
+
    procedure Set_Is_Preelaborated (Id : E; V : B := True) is
    begin
       Set_Flag59 (Id, V);
@@ -6403,7 +6405,7 @@ package body Einfo is
       else
          S := Subprograms_For_Type (Id);
          while Present (S) loop
-            if Has_Invariants (S) then
+            if Is_Invariant_Procedure (S) then
                return S;
             else
                S := Subprograms_For_Type (S);
@@ -7121,7 +7123,7 @@ package body Einfo is
       else
          S := Subprograms_For_Type (Id);
          while Present (S) loop
-            if Has_Predicates (S) then
+            if Is_Predicate_Function (S) then
                return S;
             else
                S := Subprograms_For_Type (S);
@@ -7132,6 +7134,33 @@ package body Einfo is
       end if;
    end Predicate_Function;
 
+   --------------------------
+   -- Predicate_Function_M --
+   --------------------------
+
+   function Predicate_Function_M (Id : E) return E is
+      S : Entity_Id;
+
+   begin
+      pragma Assert (Is_Type (Id));
+
+      if No (Subprograms_For_Type (Id)) then
+         return Empty;
+
+      else
+         S := Subprograms_For_Type (Id);
+         while Present (S) loop
+            if Is_Predicate_Function_M (S) then
+               return S;
+            else
+               S := Subprograms_For_Type (S);
+            end if;
+         end loop;
+
+         return Empty;
+      end if;
+   end Predicate_Function_M;
+
    -------------------------
    -- Present_In_Rep_Item --
    -------------------------
@@ -7365,8 +7394,10 @@ package body Einfo is
       Set_Subprograms_For_Type (Id, V);
       Set_Subprograms_For_Type (V, S);
 
+      --  Check for duplicate entry
+
       while Present (S) loop
-         if Has_Invariants (S) then
+         if Is_Invariant_Procedure (S) then
             raise Program_Error;
          else
             S := Subprograms_For_Type (S);
@@ -7389,7 +7420,7 @@ package body Einfo is
       Set_Subprograms_For_Type (V, S);
 
       while Present (S) loop
-         if Has_Predicates (S) then
+         if Is_Predicate_Function (S) then
             raise Program_Error;
          else
             S := Subprograms_For_Type (S);
@@ -7397,6 +7428,31 @@ package body Einfo is
       end loop;
    end Set_Predicate_Function;
 
+   ------------------------------
+   -- Set_Predicate_Function_M --
+   ------------------------------
+
+   procedure Set_Predicate_Function_M (Id : E; V : E) is
+      S : Entity_Id;
+
+   begin
+      pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
+
+      S := Subprograms_For_Type (Id);
+      Set_Subprograms_For_Type (Id, V);
+      Set_Subprograms_For_Type (V, S);
+
+      --  Check for duplicates
+
+      while Present (S) loop
+         if Is_Predicate_Function_M (S) then
+            raise Program_Error;
+         else
+            S := Subprograms_For_Type (S);
+         end if;
+      end loop;
+   end Set_Predicate_Function_M;
+
    -----------------
    -- Size_Clause --
    -----------------
@@ -7783,6 +7839,7 @@ package body Einfo is
       W ("Is_Internal",                     Flag17  (Id));
       W ("Is_Interrupt_Handler",            Flag89  (Id));
       W ("Is_Intrinsic_Subprogram",         Flag64  (Id));
+      W ("Is_Invariant_Procedure",          Flag257 (Id));
       W ("Is_Itype",                        Flag91  (Id));
       W ("Is_Known_Non_Null",               Flag37  (Id));
       W ("Is_Known_Null",                   Flag204 (Id));
@@ -7800,6 +7857,8 @@ package body Einfo is
       W ("Is_Packed",                       Flag51  (Id));
       W ("Is_Packed_Array_Type",            Flag138 (Id));
       W ("Is_Potentially_Use_Visible",      Flag9   (Id));
+      W ("Is_Predicate_Function",           Flag255 (Id));
+      W ("Is_Predicate_Function_M",         Flag256 (Id));
       W ("Is_Preelaborated",                Flag59  (Id));
       W ("Is_Primitive",                    Flag218 (Id));
       W ("Is_Primitive_Wrapper",            Flag195 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8616333..9b32e8b 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1587,9 +1587,7 @@ package Einfo is
 --       True, then usually the Invariant_Procedure attribute is set once the
 --       type is frozen, however this may not be true in some error situations.
 --       Note that it might be the full type which has inheritable invariants,
---       and then the flag will also be set in the private type. Also set in
---       the invariant procedure entity, to distinguish it among entries in the
---       Subprograms_For_Type.
+--       and then the flag will also be set in the private type.
 
 --    Has_Machine_Radix_Clause (Flag83)
 --       Defined in decimal types and subtypes, set if a Machine_Radix
@@ -1731,11 +1729,9 @@ package Einfo is
 --       such an object and no warning is generated.
 
 --    Has_Predicates (Flag250)
---       Defined in all entities. Set in type and subtype entities if a pragma
---       Predicate or Predicate aspect applies to the type, or if it inherits a
---       Predicate aspect from its parent or progenitor types. Also set in the
---       predicate function entity, to distinguish it among entries in the
---       Subprograms_For_Type.
+--       Defined in type and subtype entities. Set if a pragma Predicate or
+--       Predicate aspect applies to the type or subtype, or if it inherits a
+--       Predicate aspect from its parent or progenitor types.
 
 --    Has_Primitive_Operations (Flag120) [base type only]
 --       Defined in all type entities. Set if at least one primitive operation
@@ -2406,6 +2402,10 @@ package Einfo is
 --       setting of Is_Intrinsic_Subprogram, NOT simply having convention set
 --       to intrinsic, which causes intrinsic code to be generated.
 
+--    Is_Invariant_Procedure (Flag257)
+--       Defined in functions an procedures. Set for a generated invariant
+--       procedure to identify it easily in the
+
 --    Is_Itype (Flag91)
 --       Defined in all entities. Set to indicate that a type is an Itype,
 --       which means that the declaration for the type does not appear
@@ -2637,6 +2637,15 @@ package Einfo is
 --       use clause (RM 8.4(8)). Note that potentially use visible entities
 --       are not necessarily use visible (RM 8.4(9-11)).
 
+--    Is_Predicate_Function (Flag255)
+--       Present in functions and procedures. Set for generated predicate
+--       functions.
+
+--    Is_Predicate_Function_M (Flag256)
+--       Present in functions and procedures. Set for special version of
+--       predicate function generated for use in membership tests, where
+--       raise expressions are transformed to return False.
+
 --    Is_Preelaborated (Flag59)
 --       Defined in all entities, set in E_Package and E_Generic_Package
 --       entities to which a pragma Preelaborate is applied, and also in
@@ -3384,6 +3393,12 @@ package Einfo is
 --       Note: the reason this is marked as a synthesized attribute is that the
 --       way this is stored is as an element of the Subprograms_For_Type field.
 
+--    Predicate_Function_M (synthesized)
+--       Defined in all types. Present only if Predicate_Function is present,
+--       and only if the predicate function has Raise_Expression nodes. It
+--       is the special version created for membership tests, where if one of
+--       these raise expressions is executed, the result is to return False.
+
 --    Primitive_Operations (synthesized)
 --       Defined in concurrent types, tagged record types and subtypes, tagged
 --       private types and tagged incomplete types. For concurrent types whose
@@ -4844,7 +4859,6 @@ package Einfo is
    --    Has_Pragma_Thread_Local_Storage     (Flag169)
    --    Has_Pragma_Unmodified               (Flag233)
    --    Has_Pragma_Unreferenced             (Flag180)
-   --    Has_Predicates                      (Flag250)
    --    Has_Private_Declaration             (Flag155)
    --    Has_Qualified_Name                  (Flag161)
    --    Has_Stream_Size_Clause              (Flag184)
@@ -4961,6 +4975,7 @@ package Einfo is
    --    Has_Object_Size_Clause              (Flag172)
    --    Has_Pragma_Preelab_Init             (Flag221)
    --    Has_Pragma_Unreferenced_Objects     (Flag212)
+   --    Has_Predicates                      (Flag250)
    --    Has_Primitive_Operations            (Flag120)  (base type only)
    --    Has_Size_Clause                     (Flag29)
    --    Has_Specified_Layout                (Flag100)  (base type only)
@@ -5006,6 +5021,7 @@ package Einfo is
    --    Invariant_Procedure                 (synth)
    --    Is_Access_Protected_Subprogram_Type (synth)
    --    Predicate_Function                  (synth)
+   --    Predicate_Function_M                (synth)
    --    Root_Type                           (synth)
    --    Size_Clause                         (synth)
 
@@ -5360,7 +5376,10 @@ package Einfo is
    --    Is_Eliminated                       (Flag124)
    --    Is_Instantiated                     (Flag126)  (generic case only)
    --    Is_Intrinsic_Subprogram             (Flag64)
+   --    Is_Invariant_Procedure              (Flag257)  (non-generic case only)
    --    Is_Machine_Code_Subprogram          (Flag137)  (non-generic case only)
+   --    Is_Predicate_Function               (Flag255)  (non-generic case only)
+   --    Is_Predicate_Function_M             (Flag256)  (non-generic case only)
    --    Is_Primitive                        (Flag218)
    --    Is_Primitive_Wrapper                (Flag195)  (non-generic case only)
    --    Is_Private_Descendant               (Flag53)
@@ -5629,8 +5648,11 @@ package Einfo is
    --    Is_Instantiated                     (Flag126)  (generic case only)
    --    Is_Interrupt_Handler                (Flag89)
    --    Is_Intrinsic_Subprogram             (Flag64)
+   --    Is_Invariant_Procedure              (Flag257)  (non-generic case only)
    --    Is_Machine_Code_Subprogram          (Flag137)  (non-generic case only)
    --    Is_Null_Init_Proc                   (Flag178)
+   --    Is_Predicate_Function               (Flag255)  (non-generic case only)
+   --    Is_Predicate_Function_M             (Flag256)  (non-generic case only)
    --    Is_Primitive                        (Flag218)
    --    Is_Primitive_Wrapper                (Flag195)  (non-generic case only)
    --    Is_Private_Descendant               (Flag53)
@@ -6327,6 +6349,7 @@ package Einfo is
    function Is_Internal                         (Id : E) return B;
    function Is_Interrupt_Handler                (Id : E) return B;
    function Is_Intrinsic_Subprogram             (Id : E) return B;
+   function Is_Invariant_Procedure              (Id : E) return B;
    function Is_Itype                            (Id : E) return B;
    function Is_Known_Non_Null                   (Id : E) return B;
    function Is_Known_Null                       (Id : E) return B;
@@ -6344,6 +6367,8 @@ package Einfo is
    function Is_Packed                           (Id : E) return B;
    function Is_Packed_Array_Type                (Id : E) return B;
    function Is_Potentially_Use_Visible          (Id : E) return B;
+   function Is_Predicate_Function               (Id : E) return B;
+   function Is_Predicate_Function_M             (Id : E) return B;
    function Is_Preelaborated                    (Id : E) return B;
    function Is_Primitive                        (Id : E) return B;
    function Is_Primitive_Wrapper                (Id : E) return B;
@@ -6933,6 +6958,7 @@ package Einfo is
    procedure Set_Is_Internal                     (Id : E; V : B := True);
    procedure Set_Is_Interrupt_Handler            (Id : E; V : B := True);
    procedure Set_Is_Intrinsic_Subprogram         (Id : E; V : B := True);
+   procedure Set_Is_Invariant_Procedure          (Id : E; V : B := True);
    procedure Set_Is_Itype                        (Id : E; V : B := True);
    procedure Set_Is_Known_Non_Null               (Id : E; V : B := True);
    procedure Set_Is_Known_Null                   (Id : E; V : B := True);
@@ -6951,6 +6977,8 @@ package Einfo is
    procedure Set_Is_Packed                       (Id : E; V : B := True);
    procedure Set_Is_Packed_Array_Type            (Id : E; V : B := True);
    procedure Set_Is_Potentially_Use_Visible      (Id : E; V : B := True);
+   procedure Set_Is_Predicate_Function           (Id : E; V : B := True);
+   procedure Set_Is_Predicate_Function_M         (Id : E; V : B := True);
    procedure Set_Is_Preelaborated                (Id : E; V : B := True);
    procedure Set_Is_Primitive                    (Id : E; V : B := True);
    procedure Set_Is_Primitive_Wrapper            (Id : E; V : B := True);
@@ -7104,9 +7132,11 @@ package Einfo is
 
    function Invariant_Procedure                 (Id : E) return N;
    function Predicate_Function                  (Id : E) return N;
+   function Predicate_Function_M                (Id : E) return N;
 
    procedure Set_Invariant_Procedure            (Id : E; V : E);
    procedure Set_Predicate_Function             (Id : E; V : E);
+   procedure Set_Predicate_Function_M           (Id : E; V : E);
 
    -----------------------------------
    -- Field Initialization Routines --
@@ -7649,6 +7679,7 @@ package Einfo is
    pragma Inline (Is_Internal);
    pragma Inline (Is_Interrupt_Handler);
    pragma Inline (Is_Intrinsic_Subprogram);
+   pragma Inline (Is_Invariant_Procedure);
    pragma Inline (Is_Itype);
    pragma Inline (Is_Known_Non_Null);
    pragma Inline (Is_Known_Null);
@@ -7673,6 +7704,8 @@ package Einfo is
    pragma Inline (Is_Packed);
    pragma Inline (Is_Packed_Array_Type);
    pragma Inline (Is_Potentially_Use_Visible);
+   pragma Inline (Is_Predicate_Function);
+   pragma Inline (Is_Predicate_Function_M);
    pragma Inline (Is_Preelaborated);
    pragma Inline (Is_Primitive);
    pragma Inline (Is_Primitive_Wrapper);
@@ -8074,6 +8107,7 @@ package Einfo is
    pragma Inline (Set_Is_Internal);
    pragma Inline (Set_Is_Interrupt_Handler);
    pragma Inline (Set_Is_Intrinsic_Subprogram);
+   pragma Inline (Set_Is_Invariant_Procedure);
    pragma Inline (Set_Is_Itype);
    pragma Inline (Set_Is_Known_Non_Null);
    pragma Inline (Set_Is_Known_Null);
@@ -8092,6 +8126,8 @@ package Einfo is
    pragma Inline (Set_Is_Packed);
    pragma Inline (Set_Is_Packed_Array_Type);
    pragma Inline (Set_Is_Potentially_Use_Visible);
+   pragma Inline (Set_Is_Predicate_Function);
+   pragma Inline (Set_Is_Predicate_Function_M);
    pragma Inline (Set_Is_Preelaborated);
    pragma Inline (Set_Is_Primitive);
    pragma Inline (Set_Is_Primitive_Wrapper);
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 1843ee0..981cd2a 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1450,7 +1450,15 @@ package body Exp_Ch11 is
       --     do
       --       raise X [with string]
       --     in
-      --       raise Consraint_Error;
+      --       raise Constraint_Error;
+
+      --  unless the flag Convert_To_Return_False is set, in which case
+      --  the transformation is to:
+
+      --     do
+      --       return False;
+      --     in
+      --       raise Constraint_Error;
 
       --  The raise constraint error can never be executed. It is just a dummy
       --  node that can be labeled with an arbitrary type.
@@ -1458,13 +1466,23 @@ package body Exp_Ch11 is
       RCE := Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise);
       Set_Etype (RCE, Typ);
 
-      Rewrite (N,
-        Make_Expression_With_Actions (Loc,
-          Actions     => New_List (
-            Make_Raise_Statement (Loc,
-              Name       => Name (N),
-              Expression => Expression (N))),
-           Expression => RCE));
+      if Convert_To_Return_False (N) then
+         Rewrite (N,
+           Make_Expression_With_Actions (Loc,
+             Actions     => New_List (
+               Make_Simple_Return_Statement (Loc,
+                 Expression => New_Occurrence_Of (Standard_False, Loc))),
+              Expression => RCE));
+
+      else
+         Rewrite (N,
+           Make_Expression_With_Actions (Loc,
+             Actions     => New_List (
+               Make_Raise_Statement (Loc,
+                 Name       => Name (N),
+                 Expression => Expression (N))),
+              Expression => RCE));
+      end if;
 
       Analyze_And_Resolve (N, Typ);
    end Expand_N_Raise_Expression;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 15d5de0..89ffa2b 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -7675,7 +7675,7 @@ package body Exp_Ch3 is
 
          if not Has_Invariants (Typ) then
             Set_Has_Invariants (Typ);
-            Set_Has_Invariants (Proc_Id);
+            Set_Is_Invariant_Procedure (Proc_Id);
             Set_Invariant_Procedure (Typ, Proc_Id);
             Insert_After (N, Proc);
             Analyze (Proc);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 29d568e..779466a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6338,7 +6338,7 @@ package body Exp_Ch4 is
             Rewrite (N,
               Make_And_Then (Loc,
                 Left_Opnd  => Relocate_Node (N),
-                Right_Opnd => Make_Predicate_Call (Rtyp, Lop)));
+                Right_Opnd => Make_Predicate_Call (Rtyp, Lop, Mem => True)));
 
             --  Analyze new expression, mark left operand as analyzed to
             --  avoid infinite recursion adding predicate calls. Similarly,
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f6e5234..cb61a42 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5520,18 +5520,36 @@ package body Exp_Util is
 
    function Make_Predicate_Call
      (Typ  : Entity_Id;
-      Expr : Node_Id) return Node_Id
+      Expr : Node_Id;
+      Mem  : Boolean := False) return Node_Id
    is
       Loc : constant Source_Ptr := Sloc (Expr);
 
    begin
       pragma Assert (Present (Predicate_Function (Typ)));
 
+      --  Call special membership version if requested and available
+
+      if Mem then
+         declare
+            PFM : constant Entity_Id := Predicate_Function_M (Typ);
+         begin
+            if Present (PFM) then
+               return
+                 Make_Function_Call (Loc,
+                   Name                   => New_Occurrence_Of (PFM, Loc),
+                   Parameter_Associations => New_List (Relocate_Node (Expr)));
+            end if;
+         end;
+      end if;
+
+      --  Case of calling normal predicate function
+
       return
-        Make_Function_Call (Loc,
-          Name                   =>
-            New_Occurrence_Of (Predicate_Function (Typ), Loc),
-          Parameter_Associations => New_List (Relocate_Node (Expr)));
+          Make_Function_Call (Loc,
+            Name                   =>
+              New_Occurrence_Of (Predicate_Function (Typ), Loc),
+            Parameter_Associations => New_List (Relocate_Node (Expr)));
    end Make_Predicate_Call;
 
    --------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index e0b0e09..ce64345 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -647,9 +647,12 @@ package Exp_Util is
 
    function Make_Predicate_Call
      (Typ  : Entity_Id;
-      Expr : Node_Id) return Node_Id;
+      Expr : Node_Id;
+      Mem  : Boolean := False) return Node_Id;
    --  Typ is a type with Predicate_Function set. This routine builds a call to
    --  this function passing Expr as the argument, and returns it unanalyzed.
+   --  If Mem is set True, this is the special call for the membership case,
+   --  and the function called is the Predicate_Function_M if present.
 
    function Make_Predicate_Check
      (Typ  : Entity_Id;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 2f01dd4..bf3f035 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -2047,8 +2047,8 @@ package body Lib.Xref is
                      Ctyp := '*';
                   end if;
 
-                  --  Special handling for access parameters and objects of
-                  --  an anonymous access type.
+                  --  Special handling for access parameters and objects and
+                  --  components of an anonymous access type.
 
                   if Ekind_In (Etype (XE.Key.Ent),
                                E_Anonymous_Access_Type,
@@ -2056,7 +2056,9 @@ package body Lib.Xref is
                                E_Anonymous_Access_Protected_Subprogram_Type)
                   then
                      if Is_Formal (XE.Key.Ent)
-                       or else Ekind_In (XE.Key.Ent, E_Variable, E_Constant)
+                       or else
+                         Ekind_In
+                           (XE.Key.Ent, E_Variable, E_Constant, E_Component)
                      then
                         Ctyp := 'p';
                      end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5d87d3d..4f2d56c 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -82,7 +82,7 @@ package body Sem_Ch13 is
    --  type whose inherited alignment is no longer appropriate for the new
    --  size value. In this case, we reset the Alignment to unknown.
 
-   procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
+   procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id);
    --  If Typ has predicates (indicated by Has_Predicates being set for Typ,
    --  then either there are pragma Predicate entries on the rep chain for the
    --  type (note that Predicate aspects are converted to pragma Predicate), or
@@ -90,7 +90,9 @@ package body Sem_Ch13 is
    --  This procedure builds the spec and body for the Predicate function that
    --  tests these predicates. N is the freeze node for the type. The spec of
    --  the function is inserted before the freeze node, and the body of the
-   --  function is inserted after the freeze node.
+   --  function is inserted after the freeze node. If the predicate expression
+   --  has at least one Raise_Expression, then this procedure also builds the
+   --  M version of the predicate function for ue in membership tests.
 
    procedure Build_Static_Predicate
      (Typ  : Entity_Id;
@@ -4689,12 +4691,12 @@ package body Sem_Ch13 is
       --  If we have a type with predicates, build predicate function
 
       if Is_Type (E) and then Has_Predicates (E) then
-         Build_Predicate_Function (E, N);
+         Build_Predicate_Functions (E, N);
       end if;
 
       --  If type has delayed aspects, this is where we do the preanalysis at
       --  the freeze point, as part of the consistent visibility check. Note
-      --  that this must be done after calling Build_Predicate_Function or
+      --  that this must be done after calling Build_Predicate_Functions or
       --  Build_Invariant_Procedure since these subprograms fix occurrences of
       --  the subtype name in the saved expression so that they will not cause
       --  trouble in the preanalysis.
@@ -5225,9 +5227,9 @@ package body Sem_Ch13 is
       SId :=
         Make_Defining_Identifier (Loc,
           Chars => New_External_Name (Chars (Typ), "Invariant"));
-      Set_Has_Invariants (SId);
       Set_Has_Invariants (Typ);
       Set_Ekind (SId, E_Procedure);
+      Set_Is_Invariant_Procedure (SId);
       Set_Invariant_Procedure (Typ, SId);
 
       Spec :=
@@ -5597,11 +5599,11 @@ package body Sem_Ch13 is
       end if;
    end Build_Invariant_Procedure;
 
-   ------------------------------
-   -- Build_Predicate_Function --
-   ------------------------------
+   -------------------------------
+   -- Build_Predicate_Functions --
+   -------------------------------
 
-   --  The procedure that is constructed here has the form:
+   --  The procedures that are constructed here has the form:
 
    --    function typPredicate (Ixxx : typ) return Boolean is
    --    begin
@@ -5618,17 +5620,38 @@ package body Sem_Ch13 is
    --  inherited. Note that we do NOT generate Check pragmas, that's because we
    --  use this function even if checks are off, e.g. for membership tests.
 
-   procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (Typ);
-      Spec  : Node_Id;
-      SId   : Entity_Id;
-      FDecl : Node_Id;
-      FBody : Node_Id;
+   --  If the expression has at least one Raise_Expression, then we also build
+   --  the typPredicateM version of the function, in which any occurence of a
+   --  Raise_Expressioon is converted to "return False".
+
+   procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (Typ);
 
       Expr : Node_Id;
-      --  This is the expression for the return statement in the function. It
+      --  This is the expression for the result of the function. It is
       --  is build by connecting the component predicates with AND THEN.
 
+      Expr_M : Node_Id;
+      --  This is the corresponding return expression for the Predicate_M
+      --  function. It differs in that raise expressions are marked for
+      --  special expansion (see Process_REs).
+
+      Object_Name : constant Name_Id := New_Internal_Name ('I');
+      --  Name for argument of Predicate procedure. Note that we use the same
+      --  name for both predicate procedure. That way the reference within the
+      --  predicate expression is the same in both functions.
+
+      Object_Entity : constant Entity_Id :=
+                        Make_Defining_Identifier (Loc, Chars => Object_Name);
+      --  Entity for argument of Predicate procedure
+
+      Object_Entity_M : constant Entity_Id :=
+                         Make_Defining_Identifier (Loc, Chars => Object_Name);
+      --  Entity for argument of Predicate_M procedure
+
+      Raise_Expression_Present : Boolean := False;
+      --  Set True if Expr has at least one Raise_Expression
+
       procedure Add_Call (T : Entity_Id);
       --  Includes a call to the predicate function for type T in Expr if T
       --  has predicates and Predicate_Function (T) is non-empty.
@@ -5639,12 +5662,19 @@ package body Sem_Ch13 is
       --  Inheritance of predicates for the parent type is done by calling the
       --  Predicate_Function of the parent type, using Add_Call above.
 
-      Object_Name : constant Name_Id := New_Internal_Name ('I');
-      --  Name for argument of Predicate procedure
+      function Test_RE (N : Node_Id) return Traverse_Result;
+      --  Used in Test_REs, tests one node for being a raise expression, and if
+      --  so sets Raise_Expression_Present True.
 
-      Object_Entity : constant Entity_Id :=
-                        Make_Defining_Identifier (Loc, Object_Name);
-      --  The entity for the spec entity for the argument
+      procedure Test_REs is new Traverse_Proc (Test_RE);
+      --  Tests to see if Expr contains any raise expressions
+
+      function Process_RE (N : Node_Id) return Traverse_Result;
+      --  Used in Process REs, tests if node N is a raise expression, and if
+      --  so, marks it to be converted to return False.
+
+      procedure Process_REs is new Traverse_Proc (Process_RE);
+      --  Marks any raise expressions in Expr_M to return False
 
       Dynamic_Predicate_Present : Boolean := False;
       --  Set True if a dynamic predicate is present, results in the entire
@@ -5730,8 +5760,8 @@ package body Sem_Ch13 is
             Rewrite (N, Make_Identifier (Sloc (N), Object_Name));
             --  Use the Sloc of the usage name, not the defining name
 
-            Set_Entity (N, Object_Entity);
             Set_Etype (N, Typ);
+            Set_Entity (N, Object_Entity);
 
             --  We want to treat the node as if it comes from source, so that
             --  ASIS will not ignore it
@@ -5830,13 +5860,37 @@ package body Sem_Ch13 is
          end loop;
       end Add_Predicates;
 
-   --  Start of processing for Build_Predicate_Function
+      ----------------
+      -- Process_RE --
+      ----------------
 
-   begin
-      --  Initialize for construction of statement list
+      function Process_RE (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (N) = N_Raise_Expression then
+            Set_Convert_To_Return_False (N);
+            return Skip;
+         else
+            return OK;
+         end if;
+      end Process_RE;
 
-      Expr := Empty;
+      -------------
+      -- Test_RE --
+      -------------
 
+      function Test_RE (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (N) = N_Raise_Expression then
+            Raise_Expression_Present := True;
+            return Abandon;
+         else
+            return OK;
+         end if;
+      end Test_RE;
+
+   --  Start of processing for Build_Predicate_Functions
+
+   begin
       --  Return if already built or if type does not have predicates
 
       if not Has_Predicates (Typ)
@@ -5845,6 +5899,10 @@ package body Sem_Ch13 is
          return;
       end if;
 
+      --  Prepare to construct predicate expression
+
+      Expr := Empty;
+
       --  Add Predicates for the current type
 
       Add_Predicates;
@@ -5859,69 +5917,198 @@ package body Sem_Ch13 is
          end if;
       end;
 
-      --  If we have predicates, build the function
+      --  Case where predicates are present
 
       if Present (Expr) then
 
-         --  Build function declaration
+         --  Test for raise expression present
 
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Predicate"));
-         Set_Has_Predicates (SId);
-         Set_Ekind (SId, E_Function);
-         Set_Predicate_Function (Typ, SId);
+         Test_REs (Expr);
 
-         --  The predicate function is shared between views of a type.
+         --  If raise expression is present, capture a copy of Expr for use
+         --  in building the predicateM function version later on. For this
+         --  copy we replace references to Object_Entity by Object_Entity_M.
 
-         if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
-            Set_Predicate_Function (Full_View (Typ), SId);
+         if Raise_Expression_Present then
+            declare
+               Map : constant Elist_Id := New_Elmt_List;
+            begin
+               Append_Elmt (Object_Entity, Map);
+               Append_Elmt (Object_Entity_M, Map);
+               Expr_M := New_Copy_Tree (Expr, Map => Map);
+            end;
          end if;
 
-         Spec :=
-           Make_Function_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier => Object_Entity,
-                 Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
-             Result_Definition        =>
-               New_Occurrence_Of (Standard_Boolean, Loc));
-
-         FDecl := Make_Subprogram_Declaration (Loc, Specification => Spec);
-
-         --  Build function body
-
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Predicate"));
-
-         Spec :=
-           Make_Function_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   Make_Defining_Identifier (Loc, Object_Name),
-                 Parameter_Type =>
-                   New_Occurrence_Of (Typ, Loc))),
-             Result_Definition        =>
-               New_Occurrence_Of (Standard_Boolean, Loc));
-
-         FBody :=
-           Make_Subprogram_Body (Loc,
-             Specification              => Spec,
-             Declarations               => Empty_List,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => New_List (
-                   Make_Simple_Return_Statement (Loc,
-                     Expression => Expr))));
+         --  Build the main predicate function
+
+         declare
+            SId : constant Entity_Id :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => New_External_Name (Chars (Typ), "Predicate"));
+            --  The entity for the the function spec
+
+            SIdB : constant Entity_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_External_Name (Chars (Typ), "Predicate"));
+            --  The entity for the function body
+
+            Spec  : Node_Id;
+            FDecl : Node_Id;
+            FBody : Node_Id;
+
+         begin
+            --  Build function declaration
+
+            Set_Ekind (SId, E_Function);
+            Set_Is_Predicate_Function (SId);
+            Set_Predicate_Function (Typ, SId);
+
+            --  The predicate function is shared between views of a type
+
+            if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
+               Set_Predicate_Function (Full_View (Typ), SId);
+            end if;
+
+            Spec :=
+              Make_Function_Specification (Loc,
+                Defining_Unit_Name       => SId,
+                Parameter_Specifications => New_List (
+                  Make_Parameter_Specification (Loc,
+                    Defining_Identifier => Object_Entity,
+                    Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
+                Result_Definition        =>
+                  New_Occurrence_Of (Standard_Boolean, Loc));
+
+            FDecl :=
+              Make_Subprogram_Declaration (Loc,
+                Specification => Spec);
 
-         --  Insert declaration before freeze node and body after
+            --  Build function body
 
-         Insert_Before_And_Analyze (N, FDecl);
-         Insert_After_And_Analyze  (N, FBody);
+            Spec :=
+              Make_Function_Specification (Loc,
+                Defining_Unit_Name       => SIdB,
+                Parameter_Specifications => New_List (
+                  Make_Parameter_Specification (Loc,
+                    Defining_Identifier =>
+                      Make_Defining_Identifier (Loc, Object_Name),
+                    Parameter_Type =>
+                      New_Occurrence_Of (Typ, Loc))),
+                Result_Definition        =>
+                  New_Occurrence_Of (Standard_Boolean, Loc));
+
+            FBody :=
+              Make_Subprogram_Body (Loc,
+                Specification              => Spec,
+                Declarations               => Empty_List,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => New_List (
+                      Make_Simple_Return_Statement (Loc,
+                        Expression => Expr))));
+
+            --  Insert declaration before freeze node and body after
+
+            Insert_Before_And_Analyze (N, FDecl);
+            Insert_After_And_Analyze  (N, FBody);
+         end;
+
+         --  Test for raise expressions present and if so build M version
+
+         if Raise_Expression_Present then
+            declare
+               SId : constant Entity_Id :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => New_External_Name (Chars (Typ), "PredicateM"));
+               --  The entity for the the function spec
+
+               SIdB : constant Entity_Id :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => New_External_Name (Chars (Typ), "PredicateM"));
+               --  The entity for the function body
+
+               Spec  : Node_Id;
+               FDecl : Node_Id;
+               FBody : Node_Id;
+               BTemp : Entity_Id;
+
+            begin
+               --  Mark any raise expressions for special expansion
+
+               Process_REs (Expr_M);
+
+               --  Build function declaration
+
+               Set_Ekind (SId, E_Function);
+               Set_Is_Predicate_Function_M (SId);
+               Set_Predicate_Function_M (Typ, SId);
+
+               --  The predicate function is shared between views of a type
+
+               if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
+                  Set_Predicate_Function_M (Full_View (Typ), SId);
+               end if;
+
+               Spec :=
+                 Make_Function_Specification (Loc,
+                   Defining_Unit_Name       => SId,
+                   Parameter_Specifications => New_List (
+                     Make_Parameter_Specification (Loc,
+                       Defining_Identifier => Object_Entity_M,
+                       Parameter_Type      => New_Occurrence_Of (Typ, Loc))),
+                   Result_Definition        =>
+                     New_Occurrence_Of (Standard_Boolean, Loc));
+
+               FDecl :=
+                 Make_Subprogram_Declaration (Loc,
+                   Specification => Spec);
+
+               --  Build function body
+
+               Spec :=
+                 Make_Function_Specification (Loc,
+                   Defining_Unit_Name       => SIdB,
+                   Parameter_Specifications => New_List (
+                     Make_Parameter_Specification (Loc,
+                       Defining_Identifier =>
+                         Make_Defining_Identifier (Loc, Object_Name),
+                       Parameter_Type =>
+                         New_Occurrence_Of (Typ, Loc))),
+                   Result_Definition        =>
+                     New_Occurrence_Of (Standard_Boolean, Loc));
+
+               --  Build the body, we declare the boolean expression before
+               --  doing the return, because we are not really confident of
+               --  what happens if a return appears within a return!
+
+               BTemp :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => New_Internal_Name ('B'));
+
+               FBody :=
+                 Make_Subprogram_Body (Loc,
+                   Specification              => Spec,
+
+                   Declarations               => New_List (
+                     Make_Object_Declaration (Loc,
+                       Defining_Identifier => BTemp,
+                       Constant_Present    => True,
+                         Object_Definition =>
+                           New_Reference_To (Standard_Boolean, Loc),
+                         Expression        => Expr_M)),
+
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => New_List (
+                         Make_Simple_Return_Statement (Loc,
+                           Expression => New_Reference_To (BTemp, Loc)))));
+
+               --  Insert declaration before freeze node and body after
+
+               Insert_Before_And_Analyze (N, FDecl);
+               Insert_After_And_Analyze  (N, FBody);
+            end;
+         end if;
 
          --  Deal with static predicate case
 
@@ -5944,7 +6131,7 @@ package body Sem_Ch13 is
             end if;
          end if;
       end if;
-   end Build_Predicate_Function;
+   end Build_Predicate_Functions;
 
    ----------------------------
    -- Build_Static_Predicate --
@@ -6449,7 +6636,10 @@ package body Sem_Ch13 is
                   declare
                      Ent : constant Entity_Id := Entity (Name (Exp));
                   begin
-                     if Has_Predicates (Ent) then
+                     if Is_Predicate_Function (Ent)
+                          or else
+                        Is_Predicate_Function_M (Ent)
+                     then
                         return Stat_Pred (Etype (First_Formal (Ent)));
                      end if;
                   end;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9a116c4..76eae4c 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7896,12 +7896,11 @@ package body Sem_Prag is
                end if;
             end if;
 
-            --  Now you might think we could just do the same with the
-            --  Boolean expression if checks are off (and expansion is on)
-            --  and then rewrite the check as a null
-            --  statement. This would work but we would lose the useful
-            --  warnings about an assertion being bound to fail even if
-            --  assertions are turned off.
+            --  Now you might think we could just do the same with the Boolean
+            --  expression if checks are off (and expansion is on) and then
+            --  rewrite the check as a null statement. This would work but we
+            --  would lose the useful warnings about an assertion being bound
+            --  to fail even if assertions are turned off.
 
             --  So instead we wrap the boolean expression in an if statement
             --  that looks like:
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 49515c8..c43c4f6 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3935,7 +3935,9 @@ package body Sem_Res is
                --  infinite recursion.
 
                if not (Ekind (Nam) = E_Function
-                        and then Has_Predicates (Nam))
+                        and then (Is_Predicate_Function (Nam)
+                                    or else
+                                  Is_Predicate_Function_M (Nam)))
                then
                   Apply_Predicate_Check (A, F_Typ);
                end if;
@@ -9792,7 +9794,9 @@ package body Sem_Res is
       if Has_Predicates (Target_Typ) then
          if Nkind (Parent (N)) = N_Function_Call
            and then Present (Name (Parent (N)))
-           and then Has_Predicates (Entity (Name (Parent (N))))
+           and then (Is_Predicate_Function (Entity (Name (Parent (N))))
+                       or else
+                     Is_Predicate_Function_M (Entity (Name (Parent (N)))))
          then
             null;
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 19896ea..98dbe55 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -602,6 +602,14 @@ package body Sinfo is
       return Flag14 (N);
    end Conversion_OK;
 
+   function Convert_To_Return_False
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Raise_Expression);
+      return Flag13 (N);
+   end Convert_To_Return_False;
+
    function Corresponding_Aspect
       (N : Node_Id) return Node_Id is
    begin
@@ -3685,6 +3693,14 @@ package body Sinfo is
       Set_Flag14 (N, Val);
    end Set_Conversion_OK;
 
+   procedure Set_Convert_To_Return_False
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Raise_Expression);
+      Set_Flag13 (N, Val);
+   end Set_Convert_To_Return_False;
+
    procedure Set_Corresponding_Aspect
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 89f11f7..59c60b9 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -720,6 +720,12 @@ package Sinfo is
    --    direct conversion of the underlying integer result, with no regard to
    --    the small operand.
 
+   --  Convert_To_Return_False (Flag13-Sem)
+   --    Present in N_Raise_Expression nodes that appear in the body of the
+   --    special predicateM function used to test a predicate in the context
+   --    of a membership test, where raise expression results in returning a
+   --    value of False rather than raising an exception.
+
    --  Corresponding_Aspect (Node3-Sem)
    --    Present in N_Pragma node. Used to point back to the source aspect from
    --    the corresponding pragma. This field is Empty for source pragmas.
@@ -6139,6 +6145,7 @@ package Sinfo is
       --  Sloc points to RAISE
       --  Name (Node2) (always present)
       --  Expression (Node3) (set to Empty if no expression present)
+      --  Convert_To_Return_False (Flag13-Sem)
       --  plus fields for expression
 
       -------------------------------
@@ -8299,6 +8306,9 @@ package Sinfo is
    function Conversion_OK
      (N : Node_Id) return Boolean;    -- Flag14
 
+   function Convert_To_Return_False
+     (N : Node_Id) return Boolean;    -- Flag13
+
    function Corresponding_Aspect
      (N : Node_Id) return Node_Id;    -- Node3
 
@@ -9280,6 +9290,9 @@ package Sinfo is
    procedure Set_Conversion_OK
      (N : Node_Id; Val : Boolean := True);    -- Flag14
 
+   procedure Set_Convert_To_Return_False
+     (N : Node_Id; Val : Boolean := True);    -- Flag13
+
    procedure Set_Corresponding_Aspect
      (N : Node_Id; Val : Node_Id);            -- Node3
 
@@ -11880,6 +11893,7 @@ package Sinfo is
    pragma Inline (Context_Items);
    pragma Inline (Context_Pending);
    pragma Inline (Controlling_Argument);
+   pragma Inline (Convert_To_Return_False);
    pragma Inline (Conversion_OK);
    pragma Inline (Corresponding_Aspect);
    pragma Inline (Corresponding_Body);
@@ -12204,6 +12218,7 @@ package Sinfo is
    pragma Inline (Set_Context_Items);
    pragma Inline (Set_Context_Pending);
    pragma Inline (Set_Controlling_Argument);
+   pragma Inline (Set_Convert_To_Return_False);
    pragma Inline (Set_Conversion_OK);
    pragma Inline (Set_Corresponding_Aspect);
    pragma Inline (Set_Corresponding_Body);