2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch6.adb (Expand_Actuals): Add a predicate check on an
	actual the related type has a predicate function.
	* sem_ch3.adb (Constant_Redeclaration): Ensure that the related
	type has an invariant procedure before building a call to it.
	* sem_ch6.adb (Append_Enabled_Item): New routine.
	(Check_Access_Invariants): Use routine
	Append_Enabled_Item to chain onto the list of postconditions.
	(Contains_Enabled_Pragmas): Removed.
	(Expand_Contract_Cases): Use routine Append_Enabled_Item to chain onto
	the list of postconditions.
	(Invariants_Or_Predicates_Present): Removed.
	(Process_PPCs): Partially reimplemented.

2013-04-24  Sergey Rybin  <rybin@adacore.com frybin>

	* tree_io.ads: Update ASIS_Version_Number because of changes
	in the way how entities are chained in a scope by means of
	Next_Entity link.

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

	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
	Storage_Size): If the clause is not from an aspect, insert
	assignment to size variable of task type at the point of the
	clause, not after the task definition, to prevent access before
	elaboration in the back-end.

2013-04-24  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb (Sig_Flags): Set correct value for Pragma_Assume.

2013-04-24  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Document 'Loop_Entry.

2013-04-24  Jose Ruiz  <ruiz@adacore.com>

	* s-tassta.adb, s-tarest.adb (Task_Wrapper): Start looking for
	fall-back termination handlers from the parents, because they apply
	only to dependent tasks.
	* s-solita.adb (Task_Termination_Handler_T): Do not look for fall-back
	termination handlers because the environment task has no parent,
	and if it defines one of these handlers it does not apply to
	itself because they apply only to dependent tasks.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198244 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 310 insertions, 284 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3e5597a4b6e..cfa0ea749ab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb (Expand_Actuals): Add a predicate check on an
+	actual the related type has a predicate function.
+	* sem_ch3.adb (Constant_Redeclaration): Ensure that the related
+	type has an invariant procedure before building a call to it.
+	* sem_ch6.adb (Append_Enabled_Item): New routine.
+	(Check_Access_Invariants): Use routine
+	Append_Enabled_Item to chain onto the list of postconditions.
+	(Contains_Enabled_Pragmas): Removed.
+	(Expand_Contract_Cases): Use routine Append_Enabled_Item to chain onto
+	the list of postconditions.
+	(Invariants_Or_Predicates_Present): Removed.
+	(Process_PPCs): Partially reimplemented.
+
+2013-04-24  Sergey Rybin  <rybin@adacore.com frybin>
+
+	* tree_io.ads: Update ASIS_Version_Number because of changes
+	in the way how entities are chained in a scope by means of
+	Next_Entity link.
+
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
+	Storage_Size): If the clause is not from an aspect, insert
+	assignment to size variable of task type at the point of the
+	clause, not after the task definition, to prevent access before
+	elaboration in the back-end.
+
+2013-04-24  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Sig_Flags): Set correct value for Pragma_Assume.
+
+2013-04-24  Yannick Moy  <moy@adacore.com>
+
+	* gnat_rm.texi: Document 'Loop_Entry.
+
+2013-04-24  Jose Ruiz  <ruiz@adacore.com>
+
+	* s-tassta.adb, s-tarest.adb (Task_Wrapper): Start looking for
+	fall-back termination handlers from the parents, because they apply
+	only to dependent tasks.
+	* s-solita.adb (Task_Termination_Handler_T): Do not look for fall-back
+	termination handlers because the environment task has no parent,
+	and if it defines one of these handlers it does not apply to
+	itself because they apply only to dependent tasks.
+
 2013-04-24  Robert Dewar  <dewar@adacore.com>
 
 	* sem_type.adb, exp_attr.adb, exp_ch4.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 364401d634b..295d4ade56a 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -184,8 +184,19 @@ package body Exp_Ch13 is
                       Expression =>
                         Convert_To (RTE (RE_Size_Type), Expression (N)));
 
-                  Insert_After
-                    (Parent (Storage_Size_Variable (Entity (N))), Assign);
+                  --  If the clause is not generated by an aspect, insert
+                  --  the assignment here.  Freezing rules ensure that this
+                  --  is safe, or clause will have been rejected already.
+
+                  if Is_List_Member (N) then
+                     Insert_After (N, Assign);
+
+                  --  Otherwise, insert assignment after task declaration.
+
+                  else
+                     Insert_After
+                       (Parent (Storage_Size_Variable (Entity (N))), Assign);
+                  end if;
 
                   Analyze (Assign);
                end;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3e33ed8a018..5b977399957 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1728,17 +1728,19 @@ package body Exp_Ch6 is
             --  procedure does not include a predicate call, so it has to be
             --  generated explicitly.
 
-            if (Has_Aspect (E_Actual, Aspect_Predicate)
-                  or else
-                Has_Aspect (E_Actual, Aspect_Dynamic_Predicate)
-                  or else
-                Has_Aspect (E_Actual, Aspect_Static_Predicate))
-              and then not Is_Init_Proc (Subp)
+            if not Is_Init_Proc (Subp)
+              and then (Has_Aspect (E_Actual, Aspect_Predicate)
+                          or else
+                        Has_Aspect (E_Actual, Aspect_Dynamic_Predicate)
+                          or else
+                        Has_Aspect (E_Actual, Aspect_Static_Predicate))
+              and then Present (Predicate_Function (E_Actual))
             then
-               if (Is_Derived_Type (E_Actual)
-                    and then Is_Overloadable (Subp)
-                    and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
-                 or else Is_Entity_Name (Actual)
+               if Is_Entity_Name (Actual)
+                 or else
+                   (Is_Derived_Type (E_Actual)
+                     and then Is_Overloadable (Subp)
+                     and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
                then
                   Append_To (Post_Call,
                     Make_Predicate_Check (E_Actual, Actual));
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 1c7133c6bae..6b2574b823d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -277,6 +277,7 @@ Implementation Defined Attributes
 * Integer_Value::
 * Invalid_Value::
 * Large::
+* Loop_Entry::
 * Machine_Size::
 * Mantissa::
 * Max_Interrupt_Priority::
@@ -6682,6 +6683,7 @@ consideration, you should minimize the use of these attributes.
 * Integer_Value::
 * Invalid_Value::
 * Large::
+* Loop_Entry::
 * Machine_Size::
 * Mantissa::
 * Max_Interrupt_Priority::
@@ -7173,6 +7175,36 @@ The @code{Large} attribute is provided for compatibility with Ada 83.  See
 the Ada 83 reference manual for an exact description of the semantics of
 this attribute.
 
+@node Loop_Entry
+@unnumberedsec Loop_Entry
+@findex Loop_Entry
+@noindent
+Syntax:
+
+@smallexample @c ada
+X'Loop_Entry [(loop_name)]
+@end smallexample
+
+@noindent
+The @code{Loop_Entry} attribute is used to refer to the value that an
+expression had upon entry to a given loop in much the same way that the
+@code{Old} attribute in a subprogram postcondition can be used to refer
+to the value an expression had upon entry to the subprogram. The
+relevant loop is either identified by the given loop name, or it is the
+innermost enclosing loop when no loop name is given.
+
+@noindent
+A @code{Loop_Entry} attribute can only occur within a
+@code{Loop_Variant} or @code{Loop_Invariant} pragma. A common use of
+@code{Loop_Entry} is to compare the current value of objects with their
+initial value at loop entry, in a @code{Loop_Invariant} pragma.
+
+@noindent
+The effect of using @code{X'Loop_Entry} is the same as declaring
+a constant initialized with the initial value of @code{X} at loop
+entry. This copy is not performed if the loop is not entered, or if the
+corresponding pragmas are ignored or disabled.
+
 @node Machine_Size
 @unnumberedsec Machine_Size
 @findex Machine_Size
diff --git a/gcc/ada/s-solita.adb b/gcc/ada/s-solita.adb
index a222c87f470..19a422a81df 100644
--- a/gcc/ada/s-solita.adb
+++ b/gcc/ada/s-solita.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-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- --
@@ -181,12 +181,13 @@ package body System.Soft_Links.Tasking is
 
       --  There is no need for explicit protection against race conditions for
       --  this part because it can only be executed by the environment task
-      --  after all the other tasks have been finalized.
+      --  after all the other tasks have been finalized. Note that there is no
+      --  fall-back handler which could apply to this environment task because
+      --  it has no parents, and, as specified in ARM C.7.3 par. 9/2, "the
+      --  fall-back handler applies only to the dependent tasks of the task".
 
       if Self_Id.Common.Specific_Handler /= null then
          Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
-      elsif Self_Id.Common.Fall_Back_Handler /= null then
-         Self_Id.Common.Fall_Back_Handler.all (Cause, Self_Id, EO);
       end if;
    end Task_Termination_Handler_T;
 
diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb
index c765cc0789d..399437fccd8 100644
--- a/gcc/ada/s-tarest.adb
+++ b/gcc/ada/s-tarest.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1999-2012, Free Software Foundation, Inc.          --
+--         Copyright (C) 1999-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -268,49 +268,45 @@ package body System.Tasking.Restricted.Stages is
             Save_Occurrence (EO, E);
       end;
 
-      --  Look for a fall-back handler. It can be either in the task itself
-      --  or in the environment task. Note that this code is always executed
-      --  by a task whose master is the environment task. The task termination
-      --  code for the environment task is executed by
-      --  SSL.Task_Termination_Handler.
+      --  Look for a fall-back handler.
 
       --  This package is part of the restricted run time which supports
       --  neither task hierarchies (No_Task_Hierarchy) nor specific task
       --  termination handlers (No_Specific_Termination_Handlers).
 
-      --  There is no need for explicit protection against race conditions
-      --  for Self_ID.Common.Fall_Back_Handler because this procedure can
-      --  only be executed by Self, and the Fall_Back_Handler can only be
-      --  modified by Self.
+      --  As specified in ARM C.7.3 par. 9/2, "the fall-back handler applies
+      --  only to the dependent tasks of the task". Hence, if the terminating
+      --  tasks (Self_ID) had a fall-back handler, it would not apply to
+      --  itself. This code is always executed by a task whose master is the
+      --  environment task (the task termination code for the environment task
+      --  is executed by SSL.Task_Termination_Handler), so the fall-back
+      --  handler to execute for this task can only be defined by its parent
+      --  (there is no grandparent).
 
-      if Self_ID.Common.Fall_Back_Handler /= null then
-         Self_ID.Common.Fall_Back_Handler (Cause, Self_ID, EO);
-      else
-         declare
-            TH : Termination_Handler := null;
+      declare
+         TH : Termination_Handler := null;
 
-         begin
-            if Single_Lock then
-               Lock_RTS;
-            end if;
+      begin
+         if Single_Lock then
+            Lock_RTS;
+         end if;
 
-            Write_Lock (Self_ID.Common.Parent);
+         Write_Lock (Self_ID.Common.Parent);
 
-            TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
+         TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
 
-            Unlock (Self_ID.Common.Parent);
+         Unlock (Self_ID.Common.Parent);
 
-            if Single_Lock then
-               Unlock_RTS;
-            end if;
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
 
-            --  Execute the task termination handler if we found it
+         --  Execute the task termination handler if we found it
 
-            if TH /= null then
-               TH.all (Cause, Self_ID, EO);
-            end if;
-         end;
-      end if;
+         if TH /= null then
+            TH.all (Cause, Self_ID, EO);
+         end if;
+      end;
 
       Terminate_Task (Self_ID);
    end Task_Wrapper;
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 75f4e2c4e44..487bf8d5340 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.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.          --
 --                                                                          --
 -- GNARL 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- --
@@ -1075,7 +1075,7 @@ package body System.Tasking.Stages is
       procedure Search_Fall_Back_Handler (ID : Task_Id);
       --  Procedure that searches recursively a fall-back handler through the
       --  master relationship. If the handler is found, its pointer is stored
-      --  in TH.
+      --  in TH. It stops when the handler is found or when the ID is null.
 
       ------------------------------
       -- Search_Fall_Back_Handler --
@@ -1083,21 +1083,22 @@ package body System.Tasking.Stages is
 
       procedure Search_Fall_Back_Handler (ID : Task_Id) is
       begin
+         --  A null Task_Id indicates that we have reached the root of the
+         --  task hierarchy and no handler has been found.
+
+         if ID = null then
+            return;
+
          --  If there is a fall back handler, store its pointer for later
          --  execution.
 
-         if ID.Common.Fall_Back_Handler /= null then
+         elsif ID.Common.Fall_Back_Handler /= null then
             TH := ID.Common.Fall_Back_Handler;
 
          --  Otherwise look for a fall back handler in the parent
 
-         elsif ID.Common.Parent /= null then
-            Search_Fall_Back_Handler (ID.Common.Parent);
-
-         --  Otherwise, do nothing
-
          else
-            return;
+            Search_Fall_Back_Handler (ID.Common.Parent);
          end if;
       end Search_Fall_Back_Handler;
 
@@ -1331,9 +1332,12 @@ package body System.Tasking.Stages is
          TH := Self_ID.Common.Specific_Handler;
       else
          --  Look for a fall-back handler following the master relationship
-         --  for the task.
+         --  for the task. As specified in ARM C.7.3 par. 9/2, "the fall-back
+         --  handler applies only to the dependent tasks of the task". Hence,
+         --  if the terminating tasks (Self_ID) had a fall-back handler, it
+         --  would not apply to itself, so we start the search with the parent.
 
-         Search_Fall_Back_Handler (Self_ID);
+         Search_Fall_Back_Handler (Self_ID.Common.Parent);
       end if;
 
       Unlock (Self_ID);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 89f11dc6c83..9e5b8deb313 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -10761,13 +10761,9 @@ package body Sem_Ch3 is
          --  A deferred constant is a visible entity. If type has invariants,
          --  verify that the initial value satisfies them.
 
-         if Expander_Active and then Has_Invariants (T) then
-            declare
-               Call : constant Node_Id :=
-                 Make_Invariant_Call (New_Occurrence_Of (Prev, Sloc (N)));
-            begin
-               Insert_After (N, Call);
-            end;
+         if Has_Invariants (T) and then Present (Invariant_Procedure (T)) then
+            Insert_After (N,
+              Make_Invariant_Call (New_Occurrence_Of (Prev, Sloc (N))));
          end if;
       end if;
    end Constant_Redeclaration;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index c6db45270ba..b9be549578a 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -332,14 +332,14 @@ package body Sem_Ch6 is
          end;
       end if;
 
-      Prev     := Current_Entity_In_Scope (Defining_Entity (Spec));
+      Prev := Current_Entity_In_Scope (Defining_Entity (Spec));
 
       --  If there are previous overloadable entities with the same name,
       --  check whether any of them is completed by the expression function.
 
       if Present (Prev) and then Is_Overloadable (Prev) then
-         Def_Id   := Analyze_Subprogram_Specification (Spec);
-         Prev     := Find_Corresponding_Spec (N);
+         Def_Id := Analyze_Subprogram_Specification (Spec);
+         Prev   := Find_Corresponding_Spec (N);
       end if;
 
       Ret := Make_Simple_Return_Statement (LocX, Expression (N));
@@ -11198,18 +11198,17 @@ package body Sem_Ch6 is
       Plist : List_Id := No_List;
       --  List of generated postconditions
 
+      procedure Append_Enabled_Item (Item : Node_Id; List : in out List_Id);
+      --  Append a node to a list. If there is no list, create a new one. When
+      --  the item denotes a pragma, it is added to the list only when it is
+      --  enabled.
+
       procedure Check_Access_Invariants (E : Entity_Id);
       --  If the subprogram returns an access to a type with invariants, or
       --  has access parameters whose designated type has an invariant, then
       --  under the same visibility conditions as for other invariant checks,
       --  the type invariant must be applied to the returned value.
 
-      function Contains_Enabled_Pragmas (L : List_Id) return Boolean;
-      --  Determine whether list L has at least one enabled pragma. The routine
-      --  ignores other non-pragma elements.
-      --  This is NOT what the routine does??? It returns False if there is
-      --  one ignored pragma ???
-
       procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id);
       --  Given pragma Contract_Cases CCs, create the circuitry needed to
       --  evaluate case guards and trigger consequence expressions. Subp_Id
@@ -11226,11 +11225,6 @@ package body Sem_Ch6 is
       procedure Insert_After_Last_Declaration (Nod : Node_Id);
       --  Insert node Nod after the last declaration of the context
 
-      function Invariants_Or_Predicates_Present return Boolean;
-      --  Determines if any invariants or predicates are present for any OUT
-      --  or IN OUT parameters of the subprogram, or (for a function) if the
-      --  return value has an invariant.
-
       function Is_Public_Subprogram_For (T : Entity_Id) return Boolean;
       --  T is the entity for a private type for which invariants are defined.
       --  This function returns True if the procedure corresponding to the
@@ -11240,6 +11234,30 @@ package body Sem_Ch6 is
       --  that an invariant check is required (for an IN OUT parameter, or
       --  the returned value of a function.
 
+      -------------------------
+      -- Append_Enabled_Item --
+      -------------------------
+
+      procedure Append_Enabled_Item (Item : Node_Id; List : in out List_Id) is
+      begin
+         --  Do not chain ignored or disabled pragmas
+
+         if Nkind (Item) = N_Pragma
+           and then (Is_Ignored (Item) or else Is_Disabled (Item))
+         then
+            null;
+
+         --  Add the item
+
+         else
+            if No (List) then
+               List := New_List;
+            end if;
+
+            Append (Item, List);
+         end if;
+      end Append_Enabled_Item;
+
       -----------------------------
       -- Check_Access_Invariants --
       -----------------------------
@@ -11266,39 +11284,18 @@ package body Sem_Ch6 is
 
                Call := Make_Invariant_Call (Obj);
 
-               Append_To (Plist,
-                 Make_If_Statement (Loc,
-                   Condition =>
-                     Make_Op_Ne (Loc,
-                       Left_Opnd   => Make_Null (Loc),
-                       Right_Opnd  => New_Occurrence_Of (E, Loc)),
-                   Then_Statements => New_List (Call)));
+               Append_Enabled_Item
+                 (Make_If_Statement (Loc,
+                    Condition =>
+                      Make_Op_Ne (Loc,
+                        Left_Opnd   => Make_Null (Loc),
+                        Right_Opnd  => New_Occurrence_Of (E, Loc)),
+                    Then_Statements => New_List (Call)),
+                  List => Plist);
             end if;
          end if;
       end Check_Access_Invariants;
 
-      ------------------------------
-      -- Contains_Enabled_Pragmas --
-      ------------------------------
-
-      --  This routine does not implement its documented spec ???
-
-      function Contains_Enabled_Pragmas (L : List_Id) return Boolean is
-         Prag : Node_Id;
-
-      begin
-         Prag := First (L);
-         while Present (Prag) loop
-            if Nkind (Prag) = N_Pragma and then Is_Ignored (Prag) then
-               return False;
-            end if;
-
-            Next (Prag);
-         end loop;
-
-         return True;
-      end Contains_Enabled_Pragmas;
-
       ---------------------------
       -- Expand_Contract_Cases --
       ---------------------------
@@ -11759,11 +11756,7 @@ package body Sem_Ch6 is
          --  Raise Assertion_Error when the corresponding consequence of a case
          --  guard that evaluated to True fails.
 
-         if No (Plist) then
-            Plist := New_List;
-         end if;
-
-         Append_To (Plist, Conseq_Checks);
+         Append_Enabled_Item (Conseq_Checks, Plist);
       end Expand_Contract_Cases;
 
       --------------
@@ -11889,51 +11882,6 @@ package body Sem_Ch6 is
          end if;
       end Insert_After_Last_Declaration;
 
-      --------------------------------------
-      -- Invariants_Or_Predicates_Present --
-      --------------------------------------
-
-      function Invariants_Or_Predicates_Present return Boolean is
-         Formal : Entity_Id;
-
-      begin
-         --  Check function return result. If result is an access type there
-         --  may be invariants on the designated type.
-
-         if Ekind (Designator) /= E_Procedure
-           and then Has_Invariants (Etype (Designator))
-         then
-            return True;
-
-         elsif Ekind (Designator) /= E_Procedure
-           and then Is_Access_Type (Etype (Designator))
-           and then Has_Invariants (Designated_Type (Etype (Designator)))
-         then
-            return True;
-         end if;
-
-         --  Check parameters
-
-         Formal := First_Formal (Designator);
-         while Present (Formal) loop
-            if Ekind (Formal) /= E_In_Parameter
-              and then (Has_Invariants (Etype (Formal))
-                         or else Present (Predicate_Function (Etype (Formal))))
-            then
-               return True;
-
-            elsif Is_Access_Type (Etype (Formal))
-              and then Has_Invariants (Designated_Type (Etype (Formal)))
-            then
-               return True;
-            end if;
-
-            Next_Formal (Formal);
-         end loop;
-
-         return False;
-      end Invariants_Or_Predicates_Present;
-
       ------------------------------
       -- Is_Public_Subprogram_For --
       ------------------------------
@@ -11986,6 +11934,14 @@ package body Sem_Ch6 is
          end if;
       end Is_Public_Subprogram_For;
 
+      --  Local variables
+
+      Formal     : Node_Id;
+      Formal_Typ : Entity_Id;
+      Func_Typ   : Entity_Id;
+      Post_Proc  : Entity_Id;
+      Result     : Node_Id;
+
    --  Start of processing for Process_PPCs
 
    begin
@@ -11997,10 +11953,18 @@ package body Sem_Ch6 is
          Designator := Body_Id;
       end if;
 
+      --  Do not process a predicate function as its body will contain a
+      --  recursive call to itself and blow up the stack.
+
+      if Ekind (Designator) = E_Function
+        and then Is_Predicate_Function (Designator)
+      then
+         return;
+
       --  Internally generated subprograms, such as type-specific functions,
       --  don't get assertion checks.
 
-      if Get_TSS_Name (Designator) /= TSS_Null then
+      elsif Get_TSS_Name (Designator) /= TSS_Null then
          return;
       end if;
 
@@ -12153,10 +12117,6 @@ package body Sem_Ch6 is
                --  Capture postcondition pragmas
 
                if Pragma_Name (Prag) = Name_Postcondition then
-                  if Plist = No_List then
-                     Plist := Empty_List;
-                  end if;
-
                   Analyze (Prag);
 
                   --  If expansion is disabled, as in a generic unit, save
@@ -12165,7 +12125,7 @@ package body Sem_Ch6 is
                   if not Expander_Active then
                      Prepend (Grab_PPC, Declarations (N));
                   else
-                     Append (Grab_PPC, Plist);
+                     Append_Enabled_Item (Grab_PPC, Plist);
                   end if;
                end if;
 
@@ -12244,14 +12204,10 @@ package body Sem_Ch6 is
                   if Pragma_Name (Prag) = Name_Postcondition
                     and then (not Class or else Class_Present (Prag))
                   then
-                     if Plist = No_List then
-                        Plist := Empty_List;
-                     end if;
-
                      if not Expander_Active then
                         Prepend (Grab_PPC (Pspec), Declarations (N));
                      else
-                        Append (Grab_PPC (Pspec), Plist);
+                        Append_Enabled_Item (Grab_PPC (Pspec), Plist);
                      end if;
                   end if;
 
@@ -12285,147 +12241,126 @@ package body Sem_Ch6 is
          end Spec_Postconditions;
       end if;
 
-      --  If we had any postconditions and expansion is enabled, or if the
-      --  subprogram has invariants, then build the _Postconditions procedure.
+      --  Add an invariant call to check the result of a function
 
-      if Expander_Active
-        and then (Invariants_Or_Predicates_Present
-                   or else (Present (Plist)
-                             and then Contains_Enabled_Pragmas (Plist)))
+      if Ekind (Designator) /= E_Procedure
+        and then Expander_Active
+        and then Assertions_Enabled
       then
-         if No (Plist) then
-            Plist := Empty_List;
-         end if;
+         Func_Typ := Etype (Designator);
+         Result   := Make_Defining_Identifier (Loc, Name_uResult);
 
-         --  Special processing for function return
+         Set_Etype (Result, Func_Typ);
 
-         if Ekind (Designator) /= E_Procedure then
-            declare
-               Rent : constant Entity_Id :=
-                        Make_Defining_Identifier (Loc, Name_uResult);
-               Ftyp : constant Entity_Id := Etype (Designator);
+         --  Add argument for return
 
-            begin
-               Set_Etype (Rent, Ftyp);
+         Parms := New_List (
+           Make_Parameter_Specification (Loc,
+             Defining_Identifier => Result,
+             Parameter_Type      => New_Occurrence_Of (Func_Typ, Loc)));
 
-               --  Add argument for return
+         --  Add invariant call if returning type with invariants and this is a
+         --  public function, i.e. a function declared in the visible part of
+         --  the package defining the private type.
 
-               Parms :=
-                 New_List (
-                   Make_Parameter_Specification (Loc,
-                     Parameter_Type      => New_Occurrence_Of (Ftyp, Loc),
-                     Defining_Identifier => Rent));
+         if Has_Invariants (Func_Typ)
+           and then Present (Invariant_Procedure (Func_Typ))
+           and then Is_Public_Subprogram_For (Func_Typ)
+         then
+            Append_Enabled_Item
+              (Make_Invariant_Call (New_Occurrence_Of (Result, Loc)), Plist);
+         end if;
 
-               --  Add invariant call if returning type with invariants and
-               --  this is a public function, i.e. a function declared in the
-               --  visible part of the package defining the private type.
+         --  Same if return value is an access to type with invariants
 
-               if Has_Invariants (Etype (Rent))
-                 and then Present (Invariant_Procedure (Etype (Rent)))
-                 and then Is_Public_Subprogram_For (Etype (Rent))
-               then
-                  Append_To (Plist,
-                    Make_Invariant_Call (New_Occurrence_Of (Rent, Loc)));
-               end if;
+         Check_Access_Invariants (Result);
 
-               --  Same if return value is an access to type with invariants
+      --  Procedure case
 
-               Check_Access_Invariants (Rent);
-            end;
+      else
+         Parms := No_List;
+      end if;
 
-         --  Procedure rather than a function
+      --  Add invariant calls and predicate calls for parameters. Note that
+      --  this is done for functions as well, since in Ada 2012 they can have
+      --  IN OUT args.
 
-         else
-            Parms := No_List;
-         end if;
+      if Expander_Active and then Assertions_Enabled then
+         Formal := First_Formal (Designator);
+         while Present (Formal) loop
+            if Ekind (Formal) /= E_In_Parameter
+              or else Is_Access_Type (Etype (Formal))
+            then
+               Formal_Typ := Etype (Formal);
 
-         --  Add invariant calls and predicate calls for parameters. Note that
-         --  this is done for functions as well, since in Ada 2012 they can
-         --  have IN OUT args.
+               if Has_Invariants (Formal_Typ)
+                 and then Present (Invariant_Procedure (Formal_Typ))
+                 and then Is_Public_Subprogram_For (Formal_Typ)
+               then
+                  Append_Enabled_Item
+                    (Make_Invariant_Call (New_Occurrence_Of (Formal, Loc)),
+                     Plist);
+               end if;
 
-         declare
-            Formal : Entity_Id;
-            Ftype  : Entity_Id;
+               Check_Access_Invariants (Formal);
 
-         begin
-            Formal := First_Formal (Designator);
-            while Present (Formal) loop
-               if Ekind (Formal) /= E_In_Parameter
-                 or else Is_Access_Type (Etype (Formal))
-               then
-                  Ftype := Etype (Formal);
+               if Present (Predicate_Function (Formal_Typ)) then
+                  Append_Enabled_Item
+                    (Make_Predicate_Check
+                      (Formal_Typ, New_Occurrence_Of (Formal, Loc)),
+                     Plist);
+               end if;
+            end if;
 
-                  if Has_Invariants (Ftype)
-                    and then Present (Invariant_Procedure (Ftype))
-                    and then Is_Public_Subprogram_For (Ftype)
-                  then
-                     Append_To (Plist,
-                       Make_Invariant_Call
-                         (New_Occurrence_Of (Formal, Loc)));
-                  end if;
+            Next_Formal (Formal);
+         end loop;
+      end if;
 
-                  Check_Access_Invariants (Formal);
+      --  Build and insert postcondition procedure
 
-                  if Present (Predicate_Function (Ftype)) then
-                     Append_To (Plist,
-                       Make_Predicate_Check
-                         (Ftype, New_Occurrence_Of (Formal, Loc)));
-                  end if;
-               end if;
+      if Expander_Active and then Present (Plist) then
+         Post_Proc :=
+           Make_Defining_Identifier (Loc, Chars => Name_uPostconditions);
 
-               Next_Formal (Formal);
-            end loop;
-         end;
+         --  Insert the corresponding body of a post condition pragma after the
+         --  last declaration of the context. This ensures that the body will
+         --  not cause any premature freezing as it may mention types:
 
-         --  Build and insert postcondition procedure
+         --    procedure Proc (Obj : Array_Typ) is
+         --       procedure _postconditions is
+         --       begin
+         --          ... Obj ...
+         --       end _postconditions;
 
-         declare
-            Post_Proc : constant Entity_Id :=
-              Make_Defining_Identifier (Loc, Chars => Name_uPostconditions);
-            --  The entity for the _Postconditions procedure
+         --       subtype T is Array_Typ (Obj'First (1) .. Obj'Last (1));
+         --    begin
 
-         begin
-            --  Insert the corresponding body of a post condition pragma after
-            --  the last declaration of the context. This ensures that the body
-            --  will not cause any premature freezing as it may mention types:
-
-            --    procedure Proc (Obj : Array_Typ) is
-            --       procedure _postconditions is
-            --       begin
-            --          ... Obj ...
-            --       end _postconditions;
-
-            --       subtype T is Array_Typ (Obj'First (1) .. Obj'Last (1));
-            --    begin
-
-            --  In the example above, Obj is of type T but the incorrect
-            --  placement of _postconditions will cause a crash in gigi due to
-            --  an out of order reference. The body of _postconditions must be
-            --  placed after the declaration of Temp to preserve correct
-            --  visibility.
-
-            Insert_After_Last_Declaration (
-              Make_Subprogram_Body (Loc,
-                Specification =>
-                  Make_Procedure_Specification (Loc,
-                    Defining_Unit_Name => Post_Proc,
-                    Parameter_Specifications => Parms),
+         --  In the example above, Obj is of type T but the incorrect placement
+         --  of _postconditions will cause a crash in gigi due to an out of
+         --  order reference. The body of _postconditions must be placed after
+         --  the declaration of Temp to preserve correct visibility.
 
-                Declarations => Empty_List,
+         Insert_After_Last_Declaration (
+           Make_Subprogram_Body (Loc,
+             Specification              =>
+               Make_Procedure_Specification (Loc,
+                 Defining_Unit_Name       => Post_Proc,
+                 Parameter_Specifications => Parms),
 
-                Handled_Statement_Sequence =>
-                  Make_Handled_Sequence_Of_Statements (Loc,
-                    Statements => Plist)));
+             Declarations               => Empty_List,
 
-            Set_Ekind (Post_Proc, E_Procedure);
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => Plist)));
 
-            --  If this is a procedure, set the Postcondition_Proc attribute on
-            --  the proper defining entity for the subprogram.
+         Set_Ekind (Post_Proc, E_Procedure);
 
-            if Ekind (Designator) = E_Procedure then
-               Set_Postcondition_Proc (Designator, Post_Proc);
-            end if;
-         end;
+         --  If this is a procedure, set the Postcondition_Proc attribute on
+         --  the proper defining entity for the subprogram.
+
+         if Ekind (Designator) = E_Procedure then
+            Set_Postcondition_Proc (Designator, Post_Proc);
+         end if;
 
          Set_Has_Postconditions (Designator);
       end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a3567042ca2..18fd9ea7835 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -18218,7 +18218,7 @@ package body Sem_Prag is
       Pragma_Assert                         => -1,
       Pragma_Assert_And_Cut                 => -1,
       Pragma_Assertion_Policy               =>  0,
-      Pragma_Assume                         =>  0,
+      Pragma_Assume                         => -1,
       Pragma_Assume_No_Invalid_Values       =>  0,
       Pragma_Attribute_Definition           => +3,
       Pragma_Asynchronous                   => -1,
diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads
index 25e24c3c2db..3692d1ec650 100644
--- a/gcc/ada/tree_io.ads
+++ b/gcc/ada/tree_io.ads
@@ -47,7 +47,7 @@ package Tree_IO is
    Tree_Format_Error : exception;
    --  Raised if a format error is detected in the input file
 
-   ASIS_Version_Number : constant := 31;
+   ASIS_Version_Number : constant := 32;
    --  ASIS Version. This is used to check for consistency between the compiler
    --  used to generate trees and an ASIS application that is reading the
    --  trees. It must be incremented whenever a change is made to the tree
@@ -60,6 +60,8 @@ package Tree_IO is
    --      for concurrent types).
    --  30  Add Check_Float_Overflow boolean to tree file
    --  31  Remove read/write of Debug_Pragmas_Disabled/Debug_Pragmas_Enabled
+   --  32  Change the way entities are changed through Next_Entity field in
+   --      the hierarchy of child units
 
    procedure Tree_Read_Initialize (Desc : File_Descriptor);
    --  Called to initialize reading of a tree file. This call must be made