diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 14e82f2adc6..d59d44fd6ab 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2720,15 +2720,20 @@ package body Checks is
    ---------------------------
 
    procedure Apply_Predicate_Check
-     (N   : Node_Id;
-      Typ : Entity_Id;
-      Fun : Entity_Id := Empty)
+     (N     : Node_Id;
+      Typ   : Entity_Id;
+      Deref : Boolean := False;
+      Fun   : Entity_Id := Empty)
    is
-      Par : Node_Id;
-      S   : Entity_Id;
+      Loc            : constant Source_Ptr := Sloc (N);
+      Check_Disabled : constant Boolean :=
+        not Predicate_Enabled (Typ)
+          or else not Predicate_Check_In_Scope (N);
+
+      Expr : Node_Id;
+      Par  : Node_Id;
+      S    : Entity_Id;
 
-      Check_Disabled : constant Boolean := not Predicate_Enabled (Typ)
-        or else not Predicate_Check_In_Scope (N);
    begin
       S := Current_Scope;
       while Present (S) and then not Is_Subprogram (S) loop
@@ -2757,7 +2762,7 @@ package body Checks is
 
          if not Check_Disabled then
             Insert_Action (N,
-              Make_Raise_Storage_Error (Sloc (N),
+              Make_Raise_Storage_Error (Loc,
                 Reason => SE_Infinite_Recursion));
             return;
          end if;
@@ -2824,19 +2829,9 @@ package body Checks is
          Par := Parent (Par);
       end if;
 
-      --  For an entity of the type, generate a call to the predicate
-      --  function, unless its type is an actual subtype, which is not
-      --  visible outside of the enclosing subprogram.
-
-      if Is_Entity_Name (N)
-        and then not Is_Actual_Subtype (Typ)
-      then
-         Insert_Action (N,
-           Make_Predicate_Check
-             (Typ, New_Occurrence_Of (Entity (N), Sloc (N))));
-         return;
+      --  Try to avoid creating a temporary if the expression is an aggregate
 
-      elsif Nkind (N) in N_Aggregate | N_Extension_Aggregate then
+      if Nkind (N) in N_Aggregate | N_Extension_Aggregate then
 
          --  If the expression is an aggregate in an assignment, apply the
          --  check to the LHS after the assignment, rather than create a
@@ -2851,27 +2846,6 @@ package body Checks is
                 (Typ, Duplicate_Subexpr (Name (Par))));
             return;
 
-         --  Similarly, if the expression is a qualified aggregate in an
-         --  allocator, apply the check to the dereference of the access
-         --  value, rather than create a temporary. This is necessary for
-         --  inherently limited types, for which the temporary is illegal.
-
-         elsif Nkind (Par) = N_Allocator then
-            declare
-               Deref : constant Node_Id :=
-                         Make_Explicit_Dereference (Sloc (N),
-                           Prefix => Duplicate_Subexpr (Par));
-
-            begin
-               --  This is required by Predicate_Check_In_Scope ???
-
-               Preserve_Comes_From_Source (Deref, N);
-
-               Insert_Action_After (Parent (Par),
-                 Make_Predicate_Check (Typ, Deref));
-               return;
-            end;
-
          --  Similarly, if the expression is an aggregate in an object
          --  declaration, apply it to the object after the declaration.
 
@@ -2892,21 +2866,36 @@ package body Checks is
             then
                Insert_Action_After (Par,
                   Make_Predicate_Check (Typ,
-                    New_Occurrence_Of (Defining_Identifier (Par), Sloc (N))));
+                    New_Occurrence_Of (Defining_Identifier (Par), Loc)));
                return;
             end if;
 
          end if;
       end if;
 
-      --  If the expression is not an entity it may have side effects,
-      --  and the following call will create an object declaration for
-      --  it. We disable checks during its analysis, to prevent an
-      --  infinite recursion.
+      --  For an entity of the type, generate a call to the predicate
+      --  function, unless its type is an actual subtype, which is not
+      --  visible outside of the enclosing subprogram.
 
-      Insert_Action (N,
-        Make_Predicate_Check
-          (Typ, Duplicate_Subexpr (N)), Suppress => All_Checks);
+      if Is_Entity_Name (N) and then not Is_Actual_Subtype (Typ) then
+         Expr := New_Occurrence_Of (Entity (N), Loc);
+
+      --  If the expression is not an entity, it may have side effects
+
+      else
+         Expr := Duplicate_Subexpr (N);
+      end if;
+
+      --  Make the dereference if requested
+
+      if Deref then
+         Expr := Make_Explicit_Dereference (Loc, Prefix => Expr);
+      end if;
+
+      --  Disable checks to prevent an infinite recursion
+
+      Insert_Action
+        (N, Make_Predicate_Check (Typ, Expr), Suppress => All_Checks);
    end Apply_Predicate_Check;
 
    -----------------------
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 64f0809dbea..8fd380283cc 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -256,13 +256,14 @@ package Checks is
    --  results.
 
    procedure Apply_Predicate_Check
-     (N   : Node_Id;
-      Typ : Entity_Id;
-      Fun : Entity_Id := Empty);
+     (N     : Node_Id;
+      Typ   : Entity_Id;
+      Deref : Boolean := False;
+      Fun   : Entity_Id := Empty);
    --  N is an expression to which a predicate check may need to be applied for
-   --  Typ, if Typ has a predicate function. When N is an actual in a call, Fun
-   --  is the function being called, which is used to generate a better warning
-   --  if the call leads to an infinite recursion.
+   --  Typ if Typ has a predicate function, after dereference if Deref is True.
+   --  When N is an actual in a call, Fun is the function being called, which
+   --  is used to generate a warning if the call leads to infinite recursion.
 
    procedure Apply_Type_Conversion_Checks (N : Node_Id);
    --  N is an N_Type_Conversion node. A type conversion actually involves
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e708ed350d1..99be96d3ab7 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -563,8 +563,6 @@ package body Exp_Ch4 is
       DesigT         : constant Entity_Id  := Designated_Type (PtrT);
       Special_Return : constant Boolean    := For_Special_Return_Object (N);
 
-      --  Local variables
-
       Adj_Call      : Node_Id;
       Aggr_In_Place : Boolean;
       Node          : Node_Id;
@@ -577,8 +575,6 @@ package body Exp_Ch4 is
       TagR : Node_Id := Empty;
       --  Target reference for tag assignment
 
-   --  Start of processing for Expand_Allocator_Expression
-
    begin
       --  Handle call to C++ constructor
 
@@ -598,7 +594,15 @@ package body Exp_Ch4 is
 
       Apply_Constraint_Check (Exp, T, No_Sliding => True);
 
-      Apply_Predicate_Check (Exp, T);
+      Aggr_In_Place := Is_Delayed_Aggregate (Exp);
+
+      --  If the expression is an aggregate to be built in place, then we need
+      --  to delay applying predicate checks, because this would result in the
+      --  creation of a temporary, which is illegal for limited types,
+
+      if not Aggr_In_Place then
+         Apply_Predicate_Check (Exp, T);
+      end if;
 
       --  Check that any anonymous access discriminants are suitable
       --  for use in an allocator.
@@ -659,8 +663,6 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      Aggr_In_Place := Is_Delayed_Aggregate (Exp);
-
       --  Case of tagged type or type requiring finalization
 
       if Is_Tagged_Type (T) or else Needs_Finalization (T) then
@@ -972,6 +974,10 @@ package body Exp_Ch4 is
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
+         if Aggr_In_Place then
+            Apply_Predicate_Check (N, T, Deref => True);
+         end if;
+
          --  Ada 2005 (AI-251): Displace the pointer to reference the record
          --  component containing the secondary dispatch table of the interface
          --  type.
@@ -1012,6 +1018,10 @@ package body Exp_Ch4 is
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
+         if Aggr_In_Place then
+            Apply_Predicate_Check (N, T, Deref => True);
+         end if;
+
       elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then
          Install_Null_Excluding_Check (Exp);
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 8e5d351141d..c684075219b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4735,7 +4735,7 @@ package body Sem_Res is
                --  leads to an infinite recursion.
 
                if Predicate_Tests_On_Arguments (Nam) then
-                  Apply_Predicate_Check (A, F_Typ, Nam);
+                  Apply_Predicate_Check (A, F_Typ, Fun => Nam);
                end if;
 
                --  Apply required constraint checks
