2013-01-29 Javier Miranda <miranda@adacore.com>

	* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
	* opt.ads (Warn_On_Overlap): Update documentation.
	* sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate):
	Check function writable actuals.
	* sem_ch3.adb (Build_Derived_Record_Type,
	Record_Type_Declaration): Check function writable actuals.
	* sem_ch4.adb (Analyze_Range): Check function writable actuals.
	* sem_ch5.adb (Analyze_Assignment): Remove code of the initial
	implementation of AI05-0144.
	* sem_ch6.adb (Analyze_Function_Return,
	(Analyze_Procedure_Call.Analyze_Call_And_Resolve): Remove code
	of the initial implementation of AI05-0144.
	* sem_res.adb (Resolve): Remove code of the initial implementation.
	(Resolve_Actuals): Call Check_Function_Writable_Actuals and remove call
	of the initial implementation.
	(Resolve_Arithmetic_Op, Resolve_Logical_Op,
	Resolve_Membership_Op): Check function writable actuals.
	* sem_util.ad[sb] (Actuals_In_Call): Removed
	(Check_Order_Dependence): Removed (Save_Actual): Removed
	(Check_Function_Writable_Actuals): New subprogram.
	* usage.adb (Usage): Update documentation.
	* warnsw.adb (Set_Warning_Switch): Enable warn_on_overlap when
	setting all warnings.



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

14 files changed, 667 insertions, 176 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c8084202692..f25b41c4321 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2013-01-29  Javier Miranda  <miranda@adacore.com>
+
+	* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
+	* opt.ads (Warn_On_Overlap): Update documentation.
+	* sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate):
+	Check function writable actuals.
+	* sem_ch3.adb (Build_Derived_Record_Type,
+	Record_Type_Declaration): Check function writable actuals.
+	* sem_ch4.adb (Analyze_Range): Check function writable actuals.
+	* sem_ch5.adb (Analyze_Assignment): Remove code of the initial
+	implementation of AI05-0144.
+	* sem_ch6.adb (Analyze_Function_Return,
+	(Analyze_Procedure_Call.Analyze_Call_And_Resolve): Remove code
+	of the initial implementation of AI05-0144.
+	* sem_res.adb (Resolve): Remove code of the initial implementation.
+	(Resolve_Actuals): Call Check_Function_Writable_Actuals and remove call
+	of the initial implementation.
+	(Resolve_Arithmetic_Op, Resolve_Logical_Op,
+	Resolve_Membership_Op): Check function writable actuals.
+	* sem_util.ad[sb] (Actuals_In_Call): Removed
+	(Check_Order_Dependence): Removed (Save_Actual): Removed
+	(Check_Function_Writable_Actuals): New subprogram.
+	* usage.adb (Usage): Update documentation.
+	* warnsw.adb (Set_Warning_Switch): Enable warn_on_overlap when
+	setting all warnings.
+
 2013-01-29  Robert Dewar  <dewar@adacore.com>
 
 	* a-calend-vms.adb: Minor comment fix.
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 052b43f8dab..d9973eb2cd5 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.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- --
@@ -1458,6 +1458,15 @@ package body Errout is
       return S;
    end First_Sloc;
 
+   -----------------------
+   -- Get_Ignore_Errors --
+   -----------------------
+
+   function Get_Ignore_Errors return Boolean is
+   begin
+      return Errors_Must_Be_Ignored;
+   end Get_Ignore_Errors;
+
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index f8d1fdadb26..1dd232bed6e 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -746,6 +746,9 @@ package Errout is
    --  where the expression is parenthesized, an attempt is made to include
    --  the parentheses (i.e. to return the location of the initial paren).
 
+   function Get_Ignore_Errors return Boolean;
+   --  Return True if all error calls are ignored.
+
    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr)
      renames Erroutc.Purge_Messages;
    --  All error messages whose location is in the range From .. To (not
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 59a93103ed3..e2a97e2d434 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -1595,8 +1595,9 @@ package Opt is
 
    Warn_On_Overlap : Boolean := False;
    --  GNAT
-   --  Set to True to generate warnings when a writable actual which is not
-   --  a by-copy type overlaps with another actual in a subprogram call.
+   --  Set to True to generate warnings when a writable actual overlaps with
+   --  another actual in a subprogram call. This applies only in modes before
+   --  Ada 2012. Starting with Ada 2012, such overlaps are illegal.
    --  Modified by use of -gnatw.i/.I.
 
    Warn_On_Questionable_Missing_Parens : Boolean := True;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 5e3278a6f87..58f98f5ab9a 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.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- --
@@ -1252,6 +1252,8 @@ package body Sem_Aggr is
          Set_Etype (N, Aggr_Subtyp);
          Set_Analyzed (N);
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Resolve_Aggregate;
 
    -----------------------------
@@ -2816,6 +2818,8 @@ package body Sem_Aggr is
       else
          Error_Msg_N ("no unique type for this aggregate",  A);
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Resolve_Extension_Aggregate;
 
    ------------------------------
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3a5f693384e..5ccfe801fa9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_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- --
@@ -8061,6 +8061,8 @@ package body Sem_Ch3 is
          Set_Last_Entity
            (Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type));
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Build_Derived_Record_Type;
 
    ------------------------
@@ -19678,6 +19680,8 @@ package body Sem_Ch3 is
       then
          Derive_Progenitor_Subprograms (T, T);
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Record_Type_Declaration;
 
    ----------------------------
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 541a75ced0e..421cd81b5c3 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.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- --
@@ -3611,6 +3611,8 @@ package body Sem_Ch4 is
          Check_Universal_Expression (L);
          Check_Universal_Expression (H);
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Analyze_Range;
 
    -----------------------
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 04c07bec6d9..2e8f3a7b2f0 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.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- --
@@ -692,7 +692,6 @@ package body Sem_Ch5 is
       --  checks have been applied.
 
       Note_Possible_Modification (Lhs, Sure => True);
-      Check_Order_Dependence;
 
       --  ??? a real accessibility check is needed when ???
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 976d3e2f27b..7d67850f6ab 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.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- --
@@ -978,10 +978,6 @@ package body Sem_Ch6 is
                          & "null-excluding return??",
                Reason => CE_Null_Not_Allowed);
          end if;
-
-         --  Apply checks suggested by AI05-0144 (dangerous order dependence)
-
-         Check_Order_Dependence;
       end if;
    end Analyze_Function_Return;
 
@@ -1266,11 +1262,6 @@ package body Sem_Ch6 is
          if Nkind (N) = N_Procedure_Call_Statement then
             Analyze_Call (N);
             Resolve (N, Standard_Void_Type);
-
-            --  Apply checks suggested by AI05-0144
-
-            Check_Order_Dependence;
-
          else
             Analyze (N);
          end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a2bc095a2d4..9a4084b05f1 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.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- --
@@ -2864,18 +2864,6 @@ package body Sem_Res is
             return;
          end if;
 
-         --  AI05-144-2: Check dangerous order dependence within an expression
-         --  that is not a subexpression. Exclude RHS of an assignment, because
-         --  both sides may have side-effects and the check must be performed
-         --  over the statement.
-
-         if Nkind (Parent (N)) not in N_Subexpr
-           and then Nkind (Parent (N)) /= N_Assignment_Statement
-           and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
-         then
-            Check_Order_Dependence;
-         end if;
-
          --  The expression is definitely NOT overloaded at this point, so
          --  we reset the Is_Overloaded flag to avoid any confusion when
          --  reanalyzing the node.
@@ -3378,6 +3366,7 @@ package body Sem_Res is
 
    begin
       Check_Argument_Order;
+      Check_Function_Writable_Actuals (N);
 
       if Present (First_Actual (N)) then
          Check_Prefixed_Call;
@@ -3776,21 +3765,6 @@ package body Sem_Res is
                end if;
             end if;
 
-            --  Save actual for subsequent check on order dependence, and
-            --  indicate whether actual is modifiable. For AI05-0144-2.
-
-            --  If this is a call to a reference function that is the result
-            --  of expansion, as in element iterator loops, this does not lead
-            --  to a dangerous order dependence: only subsequent use of the
-            --  denoted element might, in some enclosing call.
-
-            if not Has_Implicit_Dereference (Etype (Nam))
-              or else Comes_From_Source (N)
-            then
-               Save_Actual (A, Ekind (F) /= E_In_Parameter);
-            end if;
-
-            --  For mode IN, if actual is an entity, and the type of the formal
             --  has warnings suppressed, then we reset Never_Set_In_Source for
             --  the calling entity. The reason for this is to catch cases like
             --  GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram
@@ -5108,6 +5082,7 @@ package body Sem_Res is
 
       Check_Unset_Reference (L);
       Check_Unset_Reference (R);
+      Check_Function_Writable_Actuals (N);
    end Resolve_Arithmetic_Op;
 
    ------------------
@@ -7632,6 +7607,8 @@ package body Sem_Res is
             end if;
          end;
       end if;
+
+      Check_Function_Writable_Actuals (N);
    end Resolve_Logical_Op;
 
    ---------------------------
@@ -7729,6 +7706,7 @@ package body Sem_Res is
 
       if Present (Alternatives (N)) then
          Resolve_Set_Membership;
+         Check_Function_Writable_Actuals (N);
          return;
 
       elsif not Is_Overloaded (R)
@@ -7793,6 +7771,7 @@ package body Sem_Res is
       end if;
 
       Eval_Membership_Op (N);
+      Check_Function_Writable_Actuals (N);
    end Resolve_Membership_Op;
 
    ------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b540169602c..c467f50ac9f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.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- --
@@ -57,7 +57,6 @@ with Sinput;   use Sinput;
 with Stand;    use Stand;
 with Style;
 with Stringt;  use Stringt;
-with Table;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
@@ -96,30 +95,6 @@ package body Sem_Util is
    subtype NCT_Header_Num is Int range 0 .. 511;
    --  Defines range of headers in hash tables (512 headers)
 
-   ----------------------------------
-   -- Order Dependence (AI05-0144) --
-   ----------------------------------
-
-   --  Each actual in a call is entered into the table below. A flag indicates
-   --  whether the corresponding formal is OUT or IN OUT. Each top-level call
-   --  (procedure call, condition, assignment) examines all the actuals for a
-   --  possible order dependence. The table is reset after each such check.
-   --  The actuals to be checked in a call to Check_Order_Dependence are at
-   --  positions 1 .. Last.
-
-   type Actual_Name is record
-      Act         : Node_Id;
-      Is_Writable : Boolean;
-   end record;
-
-   package Actuals_In_Call is new Table.Table (
-      Table_Component_Type => Actual_Name,
-      Table_Index_Type     => Int,
-      Table_Low_Bound      => 0,
-      Table_Initial        => 10,
-      Table_Increment      => 100,
-      Table_Name           => "Actuals");
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -1245,6 +1220,590 @@ package body Sem_Util is
       end if;
    end Cannot_Raise_Constraint_Error;
 
+   -------------------------------------
+   -- Check_Function_Writable_Actuals --
+   -------------------------------------
+
+   procedure Check_Function_Writable_Actuals (N : Node_Id) is
+      Writable_Actuals_List : Elist_Id := No_Elist;
+      Identifiers_List      : Elist_Id := No_Elist;
+      Error_Node            : Node_Id  := Empty;
+
+      procedure Collect_Identifiers (N : Node_Id);
+      --  In a single traversal of subtree N collect in Writable_Actuals_List
+      --  all the actuals of functions with writable actuals, and in the list
+      --  Identifiers_List collect all the identifiers that are not actuals of
+      --  functions with writable actuals. If a writable actual is referenced
+      --  twice as writable actual then Error_Node is set to reference its
+      --  second occurrence, the error is reported, and the tree traversal
+      --  is abandoned.
+
+      function Get_Function_Id (Call : Node_Id) return Entity_Id;
+      --  Return the entity associated with the function call
+
+      procedure Preanalyze_Without_Errors (N : Node_Id);
+      --  Preanalyze N without reporting errors
+
+      -------------------------
+      -- Collect_Identifiers --
+      -------------------------
+
+      procedure Collect_Identifiers (N : Node_Id) is
+
+         function Check_Node (N : Node_Id) return Traverse_Result;
+         --  Process a single node during the tree traversal to collect the
+         --  writable actuals of functions and all the identifiers which are
+         --  not writable actuals of functions.
+
+         function Contains (List : Elist_Id; N : Node_Id) return Boolean;
+         --  Returns True if List has a node whose Entity is Entity (N)
+
+         -------------------------
+         -- Check_Function_Call --
+         -------------------------
+
+         function Check_Node (N : Node_Id) return Traverse_Result is
+            Is_Writable_Actual : Boolean := False;
+
+         begin
+            if Nkind (N) = N_Identifier then
+
+               --  No analysis possible if the entity is not decorated
+
+               if No (Entity (N)) then
+                  return Skip;
+
+               --  We don't collect identifiers of packages, called functions,
+               --  etc.
+
+               elsif Ekind_In (Entity (N),
+                       E_Package,
+                       E_Function,
+                       E_Procedure,
+                       E_Entry)
+               then
+                  return Skip;
+
+               --  Analyze if N is a writable actual of a function
+
+               elsif Nkind (Parent (N)) = N_Function_Call then
+                  declare
+                     Call   : constant Node_Id   := Parent (N);
+                     Id     : constant Entity_Id := Get_Function_Id (Call);
+                     Actual : Node_Id;
+                     Formal : Node_Id;
+
+                  begin
+                     Formal := First_Formal (Id);
+                     Actual := First_Actual (Call);
+                     while Present (Actual) and then Present (Formal) loop
+                        if Actual = N then
+                           if Ekind_In (Formal, E_Out_Parameter,
+                                                E_In_Out_Parameter)
+                           then
+                              Is_Writable_Actual := True;
+                           end if;
+
+                           exit;
+                        end if;
+
+                        Next_Formal (Formal);
+                        Next_Actual (Actual);
+                     end loop;
+                  end;
+               end if;
+
+               if Is_Writable_Actual then
+                  if Contains (Writable_Actuals_List, N) then
+                     Error_Msg_N
+                       ("conflict of writable function parameter in "
+                        & "construct with arbitrary order of evaluation", N);
+                     Error_Node := N;
+                     return Abandon;
+                  end if;
+
+                  if Writable_Actuals_List = No_Elist then
+                     Writable_Actuals_List := New_Elmt_List;
+                  end if;
+
+                  Append_Elmt (N, Writable_Actuals_List);
+               else
+                  if Identifiers_List = No_Elist then
+                     Identifiers_List := New_Elmt_List;
+                  end if;
+
+                  Append_Unique_Elmt (N, Identifiers_List);
+               end if;
+            end if;
+
+            return OK;
+         end Check_Node;
+
+         --------------
+         -- Contains --
+         --------------
+
+         function Contains
+           (List : Elist_Id;
+            N    : Node_Id) return Boolean
+         is
+            pragma Assert (Nkind (N) in N_Has_Entity);
+
+            Elmt : Elmt_Id;
+         begin
+            if List = No_Elist then
+               return False;
+            end if;
+
+            Elmt := First_Elmt (List);
+            loop
+               if No (Elmt) then
+                  return False;
+               elsif Entity (Node (Elmt)) = Entity (N) then
+                  return True;
+               else
+                  Next_Elmt (Elmt);
+               end if;
+            end loop;
+         end Contains;
+
+         ------------------
+         -- Do_Traversal --
+         ------------------
+
+         procedure Do_Traversal is new Traverse_Proc (Check_Node);
+         --  The traversal procedure
+
+      --  Start of processing for Collect_Identifiers
+
+      begin
+         if Present (Error_Node) then
+            return;
+         end if;
+
+         if Nkind (N) in N_Subexpr
+           and then Is_Static_Expression (N)
+         then
+            return;
+         end if;
+
+         Do_Traversal (N);
+      end Collect_Identifiers;
+
+      ---------------------
+      -- Get_Function_Id --
+      ---------------------
+
+      function Get_Function_Id (Call : Node_Id) return Entity_Id is
+         Nam : constant Node_Id := Name (Call);
+         Id  : Entity_Id;
+      begin
+         if Nkind (Nam) = N_Explicit_Dereference then
+            Id := Etype (Nam);
+            pragma Assert (Ekind (Id) = E_Subprogram_Type);
+
+         elsif Nkind (Nam) = N_Selected_Component then
+            Id := Entity (Selector_Name (Nam));
+
+         elsif Nkind (Nam) = N_Indexed_Component then
+            Id := Entity (Selector_Name (Prefix (Nam)));
+
+         else
+            Id := Entity (Nam);
+         end if;
+
+         return Id;
+      end Get_Function_Id;
+
+      ---------------------------
+      -- Preanalyze_Expression --
+      ---------------------------
+
+      procedure Preanalyze_Without_Errors (N : Node_Id) is
+         Status : constant Boolean := Get_Ignore_Errors;
+      begin
+         Set_Ignore_Errors (True);
+         Preanalyze (N);
+         Set_Ignore_Errors (Status);
+      end Preanalyze_Without_Errors;
+
+   --  Start of processing for Check_Function_Writable_Actuals
+
+   begin
+      if Ada_Version < Ada_2012
+        or else (not (Nkind (N) in N_Op)
+                   and then not (Nkind (N) in N_Membership_Test)
+                   and then not Nkind_In (N,
+                                  N_Range,
+                                  N_Aggregate,
+                                  N_Extension_Aggregate,
+                                  N_Full_Type_Declaration,
+                                  N_Function_Call,
+                                  N_Procedure_Call_Statement,
+                                  N_Entry_Call_Statement))
+        or else (Nkind (N) = N_Full_Type_Declaration
+                   and then not Is_Record_Type (Defining_Identifier (N)))
+      then
+         return;
+      end if;
+
+      --  If a construct C has two or more direct constituents that are names
+      --  or expressions whose evaluation may occur in an arbitrary order, at
+      --  least one of which contains a function call with an in out or out
+      --  parameter, then the construct is legal only if: for each name N that
+      --  is passed as a parameter of mode in out or out to some inner function
+      --  call C2 (not including the construct C itself), there is no other
+      --  name anywhere within a direct constituent of the construct C other
+      --  than the one containing C2, that is known to refer to the same
+      --  object (RM 6.4.1(6.17/3)).
+
+      case Nkind (N) is
+         when N_Range =>
+            Collect_Identifiers (Low_Bound (N));
+            Collect_Identifiers (High_Bound (N));
+
+         when N_Op | N_Membership_Test =>
+            declare
+               Expr : Node_Id;
+            begin
+               Collect_Identifiers (Left_Opnd (N));
+
+               if Present (Right_Opnd (N)) then
+                  Collect_Identifiers (Right_Opnd (N));
+               end if;
+
+               if Nkind_In (N, N_In, N_Not_In)
+                 and then Present (Alternatives (N))
+               then
+                  Expr := First (Alternatives (N));
+                  while Present (Expr) loop
+                     Collect_Identifiers (Expr);
+
+                     Next (Expr);
+                  end loop;
+               end if;
+            end;
+
+         when N_Full_Type_Declaration =>
+            declare
+               function Get_Record_Part (N : Node_Id) return Node_Id;
+               --  Return the record part of this record type definition
+
+               function Get_Record_Part (N : Node_Id) return Node_Id is
+                  Type_Def : constant Node_Id := Type_Definition (N);
+               begin
+                  if Nkind (Type_Def) = N_Derived_Type_Definition then
+                     return Record_Extension_Part (Type_Def);
+                  else
+                     return Type_Def;
+                  end if;
+               end Get_Record_Part;
+
+               Comp   : Node_Id;
+               Def_Id : Entity_Id := Defining_Identifier (N);
+               Rec    : Node_Id   := Get_Record_Part (N);
+            begin
+               --  No need to perform any analysis if the record has no
+               --  components
+
+               if No (Rec) or else No (Component_List (Rec)) then
+                  return;
+               end if;
+
+               --  Collect the identifiers starting from the deepest
+               --  derivation. Done to report the error in the deepest
+               --  derivation.
+
+               loop
+                  if Present (Component_List (Rec)) then
+                     Comp := First (Component_Items (Component_List (Rec)));
+                     while Present (Comp) loop
+                        if Nkind (Comp) = N_Component_Declaration
+                          and then Present (Expression (Comp))
+                        then
+                           Collect_Identifiers (Expression (Comp));
+                        end if;
+
+                        Next (Comp);
+                     end loop;
+                  end if;
+
+                  exit when No (Underlying_Type (Etype (Def_Id)))
+                    or else Base_Type (Underlying_Type (Etype (Def_Id)))
+                              = Def_Id;
+
+                  Def_Id := Base_Type (Underlying_Type (Etype (Def_Id)));
+                  Rec := Get_Record_Part (Parent (Def_Id));
+               end loop;
+            end;
+
+         when N_Subprogram_Call      |
+              N_Entry_Call_Statement =>
+            declare
+               Id     : constant Entity_Id := Get_Function_Id (N);
+               Formal : Node_Id;
+               Actual : Node_Id;
+
+            begin
+               Formal := First_Formal (Id);
+               Actual := First_Actual (N);
+               while Present (Actual) and then Present (Formal) loop
+                  if Ekind_In (Formal, E_Out_Parameter,
+                                       E_In_Out_Parameter)
+                  then
+                     Collect_Identifiers (Actual);
+                  end if;
+
+                  Next_Formal (Formal);
+                  Next_Actual (Actual);
+               end loop;
+            end;
+
+         when N_Aggregate           |
+              N_Extension_Aggregate =>
+            declare
+               Assoc     : Node_Id;
+               Choice    : Node_Id;
+               Comp_Expr : Node_Id;
+
+            begin
+               --  Handle the N_Others_Choice of array aggregates with static
+               --  bounds. There is no need to perform this analysis in
+               --  aggregates without static bounds since we cannot evaluate
+               --  if the N_Others_Choice covers several elements. There is
+               --  no need to handle the N_Others choice of record aggregates
+               --  since at this stage it has been already expanded by
+               --  Resolve_Record_Aggregate.
+
+               if Is_Array_Type (Etype (N))
+                 and then Nkind (N) = N_Aggregate
+                 and then Present (Aggregate_Bounds (N))
+                 and then Compile_Time_Known_Bounds (Etype (N))
+                 and then Expr_Value (High_Bound (Aggregate_Bounds (N)))
+                            > Expr_Value (Low_Bound (Aggregate_Bounds (N)))
+               then
+                  declare
+                     Count_Components   : Uint := Uint_0;
+                     Num_Components     : Uint;
+                     Others_Assoc       : Node_Id;
+                     Others_Choice      : Node_Id := Empty;
+                     Others_Box_Present : Boolean := False;
+
+                  begin
+                     --  Count positional associations
+
+                     if Present (Expressions (N)) then
+                        Comp_Expr := First (Expressions (N));
+                        while Present (Comp_Expr) loop
+                           Count_Components := Count_Components + 1;
+                           Next (Comp_Expr);
+                        end loop;
+                     end if;
+
+                     --  Count the rest of elements and locate the N_Others
+                     --  choice (if any)
+
+                     Assoc := First (Component_Associations (N));
+                     while Present (Assoc) loop
+                        Choice := First (Choices (Assoc));
+                        while Present (Choice) loop
+                           if Nkind (Choice) = N_Others_Choice then
+                              Others_Assoc       := Assoc;
+                              Others_Choice      := Choice;
+                              Others_Box_Present := Box_Present (Assoc);
+
+                           --  Count several components
+
+                           elsif Nkind_In (Choice, N_Range,
+                                                   N_Subtype_Indication)
+                             or else (Is_Entity_Name (Choice)
+                                        and then Is_Type (Entity (Choice)))
+                           then
+                              declare
+                                 L, H : Node_Id;
+                              begin
+                                 Get_Index_Bounds (Choice, L, H);
+                                 pragma Assert
+                                   (Compile_Time_Known_Value (L)
+                                      and then Compile_Time_Known_Value (H));
+                                 Count_Components :=
+                                   Count_Components
+                                     + Expr_Value (H) - Expr_Value (L) + 1;
+                              end;
+
+                           --  Count single component. No other case available
+                           --  since we are handling an aggregate with static
+                           --  bounds.
+
+                           else
+                              pragma Assert (Is_Static_Expression (Choice)
+                                or else Nkind (Choice) = N_Identifier
+                                or else Nkind (Choice) = N_Integer_Literal);
+
+                              Count_Components := Count_Components + 1;
+                           end if;
+
+                           Next (Choice);
+                        end loop;
+
+                        Next (Assoc);
+                     end loop;
+
+                     Num_Components :=
+                       Expr_Value (High_Bound (Aggregate_Bounds (N)))
+                         - Expr_Value (Low_Bound (Aggregate_Bounds (N)))
+                         + 1;
+
+                     pragma Assert (Count_Components <= Num_Components);
+
+                     --  Handle the N_Others choice if it covers several
+                     --  components
+
+                     if Present (Others_Choice)
+                       and then (Num_Components - Count_Components) > 1
+                     then
+                        if not Others_Box_Present then
+
+                           --  At this stage, if expansion is active, the
+                           --  expression of the others choice has not been
+                           --  analyzed. Hence we generate a duplicate and
+                           --  we analyze it silently to have available the
+                           --  minimum decoration required to collect the
+                           --  identifiers.
+
+                           if not Expander_Active then
+                              Comp_Expr := Expression (Others_Assoc);
+                           else
+                              Comp_Expr :=
+                                New_Copy_Tree (Expression (Others_Assoc));
+                              Preanalyze_Without_Errors (Comp_Expr);
+                           end if;
+
+                           Collect_Identifiers (Comp_Expr);
+
+                           if Writable_Actuals_List /= No_Elist then
+
+                              --  As suggested by Robert, at current stage we
+                              --  report occurrences of this case as warnings.
+
+                              Error_Msg_N
+                                ("conflict of writable function parameter in "
+                                 & "construct with arbitrary order of "
+                                 & "evaluation?",
+                                 Node (First_Elmt (Writable_Actuals_List)));
+                           end if;
+                        end if;
+                     end if;
+                  end;
+               end if;
+
+               --  Handle ancestor part of extension aggregates
+
+               if Nkind (N) = N_Extension_Aggregate then
+                  Collect_Identifiers (Ancestor_Part (N));
+               end if;
+
+               --  Handle positional associations
+
+               if Present (Expressions (N)) then
+                  Comp_Expr := First (Expressions (N));
+                  while Present (Comp_Expr) loop
+                     if not Is_Static_Expression (Comp_Expr) then
+                        Collect_Identifiers (Comp_Expr);
+                     end if;
+
+                     Next (Comp_Expr);
+                  end loop;
+               end if;
+
+               --  Handle discrete associations
+
+               if Present (Component_Associations (N)) then
+                  Assoc := First (Component_Associations (N));
+                  while Present (Assoc) loop
+
+                     if not Box_Present (Assoc) then
+                        Choice := First (Choices (Assoc));
+                        while Present (Choice) loop
+
+                           --  For now we skip discriminants since it requires
+                           --  performing the analysis in two phases: first one
+                           --  analyzing discriminants and second one analyzing
+                           --  the rest of components since discriminants are
+                           --  evaluated prior to components: too much extra
+                           --  work to detect a corner case???
+
+                           if Nkind (Choice) in N_Has_Entity
+                             and then Present (Entity (Choice))
+                             and then Ekind (Entity (Choice))
+                                        = E_Discriminant
+                           then
+                              null;
+
+                           elsif Box_Present (Assoc) then
+                              null;
+
+                           else
+                              if not Analyzed (Expression (Assoc)) then
+                                 Comp_Expr :=
+                                   New_Copy_Tree (Expression (Assoc));
+                                 Preanalyze_Without_Errors (Comp_Expr);
+                              else
+                                 Comp_Expr := Expression (Assoc);
+                              end if;
+
+                              Collect_Identifiers (Comp_Expr);
+                           end if;
+
+                           Next (Choice);
+                        end loop;
+                     end if;
+
+                     Next (Assoc);
+                  end loop;
+               end if;
+            end;
+
+         when others =>
+            return;
+      end case;
+
+      --  No further action needed if we already reported an error
+
+      if Present (Error_Node) then
+         return;
+      end if;
+
+      --  Check if some writable argument of a function is referenced
+
+      if Writable_Actuals_List /= No_Elist
+        and then Identifiers_List /= No_Elist
+      then
+         declare
+            Elmt_1 : Elmt_Id;
+            Elmt_2 : Elmt_Id;
+
+         begin
+            Elmt_1 := First_Elmt (Writable_Actuals_List);
+            while Present (Elmt_1) loop
+               Elmt_2 := First_Elmt (Identifiers_List);
+               while Present (Elmt_2) loop
+                  if Entity (Node (Elmt_1)) = Entity (Node (Elmt_2)) then
+                     Error_Msg_N
+                       ("conflict of writable function parameter in construct "
+                        & "with arbitrary order of evaluation",
+                        Node (Elmt_1));
+                  end if;
+
+                  Next_Elmt (Elmt_2);
+               end loop;
+
+               Next_Elmt (Elmt_1);
+            end loop;
+         end;
+      end if;
+   end Check_Function_Writable_Actuals;
+
    --------------------------------
    -- Check_Implicit_Dereference --
    --------------------------------
@@ -1529,65 +2088,6 @@ package body Sem_Util is
       end if;
    end Check_Nested_Access;
 
-   ----------------------------
-   -- Check_Order_Dependence --
-   ----------------------------
-
-   procedure Check_Order_Dependence is
-      Act1 : Node_Id;
-      Act2 : Node_Id;
-
-   begin
-      if Ada_Version < Ada_2012 then
-         return;
-      end if;
-
-      --  Ada 2012 AI05-0144-2: Dangerous order dependence. Actuals in nested
-      --  calls within a construct have been collected. If one of them is
-      --  writable and overlaps with another one, evaluation of the enclosing
-      --  construct is nondeterministic. This is illegal in Ada 2012, but is
-      --  treated as a warning for now.
-
-      for J in 1 .. Actuals_In_Call.Last loop
-         if Actuals_In_Call.Table (J).Is_Writable then
-            Act1 := Actuals_In_Call.Table (J).Act;
-
-            if Nkind (Act1) = N_Attribute_Reference then
-               Act1 := Prefix (Act1);
-            end if;
-
-            for K in 1 .. Actuals_In_Call.Last loop
-               if K /= J then
-                  Act2 := Actuals_In_Call.Table (K).Act;
-
-                  if Nkind (Act2) = N_Attribute_Reference then
-                     Act2 := Prefix (Act2);
-                  end if;
-
-                  if Actuals_In_Call.Table (K).Is_Writable
-                    and then K < J
-                  then
-                     --  Already checked
-
-                     null;
-
-                  elsif Denotes_Same_Object (Act1, Act2)
-                    and then Parent (Act1) /= Parent (Act2)
-                  then
-                     Error_Msg_N
-                       ("result may differ if evaluated "
-                        & "after other actual in expression??", Act1);
-                  end if;
-               end if;
-            end loop;
-         end if;
-      end loop;
-
-      --  Remove checked actuals from table
-
-      Actuals_In_Call.Set_Last (0);
-   end Check_Order_Dependence;
-
    ------------------------------------------
    -- Check_Potentially_Blocking_Operation --
    ------------------------------------------
@@ -12595,35 +13095,6 @@ package body Sem_Util is
       end if;
    end Same_Value;
 
-   -----------------
-   -- Save_Actual --
-   -----------------
-
-   procedure Save_Actual (N : Node_Id;  Writable : Boolean := False) is
-   begin
-      if Ada_Version < Ada_2012 then
-         return;
-
-      elsif Is_Entity_Name (N)
-        or else
-          Nkind_In (N, N_Indexed_Component, N_Selected_Component, N_Slice)
-        or else
-          (Nkind (N) = N_Attribute_Reference
-            and then Attribute_Name (N) = Name_Access)
-
-      then
-         --  We are only interested in IN OUT parameters of inner calls
-
-         if not Writable
-           or else Nkind (Parent (N)) = N_Function_Call
-           or else Nkind (Parent (N)) in N_Op
-         then
-            Actuals_In_Call.Increment_Last;
-            Actuals_In_Call.Table (Actuals_In_Call.Last) := (N, Writable);
-         end if;
-      end if;
-   end Save_Actual;
-
    ------------------------
    -- Scope_Is_Transient --
    ------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index d85e574f036..0a9ff0af8f5 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -178,6 +178,17 @@ package Sem_Util is
    --  not necessarily mean that CE could be raised, but a response of True
    --  means that for sure CE cannot be raised.
 
+   procedure Check_Function_Writable_Actuals (N : Node_Id);
+   --  (Ada 2012): If the construct N has two or more direct constituents that
+   --  are names or expressions whose evaluation may occur in an arbitrary
+   --  order, at least one of which contains a function call with an in out or
+   --  out parameter, then the construct is legal only if: for each name that
+   --  is passed as a parameter of mode in out or out to some inner function
+   --  call C2 (not including the construct N itself), there is no other name
+   --  anywhere within a direct constituent of the construct C other than
+   --  the one containing C2, that is known to refer to the same object (RM
+   --  6.4.1(6.17/3)).
+
    procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id);
    --  AI05-139-2: Accessors and iterators for containers. This procedure
    --  checks whether T is a reference type, and if so it adds an interprettion
@@ -215,11 +226,6 @@ package Sem_Util is
    --  is accessed inside a nested procedure, and set Has_Up_Level_Access flag
    --  accordingly. This is currently only enabled for VM_Target /= No_VM.
 
-   procedure Check_Order_Dependence;
-   --  Examine the actuals in a top-level call to determine whether aliasing
-   --  between two actuals, one of which is writable, can make the call
-   --  order-dependent.
-
    procedure Check_Potentially_Blocking_Operation (N : Node_Id);
    --  N is one of the statement forms that is a potentially blocking
    --  operation. If it appears within a protected action, emit warning.
@@ -1404,11 +1410,6 @@ package Sem_Util is
    --  are only partially ordered, so Scope_Within_Or_Same (A,B) and
    --  Scope_Within_Or_Same (B,A) can both be False for a given pair A,B.
 
-   procedure Save_Actual (N : Node_Id; Writable : Boolean := False);
-   --  Enter an actual in a call in a table global, for subsequent check of
-   --  possible order dependence in the presence of IN OUT parameters for
-   --  functions in Ada 2012 (or access parameters in older language versions).
-
    function Scope_Within (Scope1, Scope2 : Entity_Id) return Boolean;
    --  Like Scope_Within_Or_Same, except that this function returns
    --  False in the case where Scope1 and Scope2 are the same scope.
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 4efa6076185..08a41c28069 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.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- --
@@ -502,8 +502,8 @@ begin
    Write_Line ("        .H*  turn off warnings for holes in records");
    Write_Line ("        i*+  turn on warnings for implementation unit");
    Write_Line ("        I    turn off warnings for implementation unit");
-   Write_Line ("        .i   turn on warnings for overlapping actuals");
-   Write_Line ("        .I*  turn off warnings for overlapping actuals");
+   Write_Line ("        .i*+ turn on warnings for overlapping actuals");
+   Write_Line ("        .I   turn off warnings for overlapping actuals");
    Write_Line ("        j+   turn on warnings for obsolescent " &
                                                   "(annex J) feature");
    Write_Line ("        J*   turn off warnings for obsolescent " &
diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb
index 337f4699bd3..c194b3182c1 100644
--- a/gcc/ada/warnsw.adb
+++ b/gcc/ada/warnsw.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.         --
 --                                                                          --
 -- 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- --
@@ -292,6 +292,7 @@ package body Warnsw is
             Warn_On_Non_Local_Exception         := True;
             Warn_On_Object_Renames_Function     := True;
             Warn_On_Obsolescent_Feature         := True;
+            Warn_On_Overlap                     := True;
             Warn_On_Parameter_Order             := True;
             Warn_On_Questionable_Missing_Parens := True;
             Warn_On_Redundant_Constructs        := True;