[multiple changes]

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.

From-SVN: r198244

gcc/ada/ChangeLog

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

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;

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));

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

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;
 

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;

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);

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;

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,

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