Merge branch 'autopar_rebase2' into autopar_develdevel/autopar_devel

Quickly commit changes in the rebase branch.

1 files changed, 66 insertions, 36 deletions

diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb
index f5e2eb4..c2a0a83 100644
--- a/gcc/ada/libgnat/a-convec.adb
+++ b/gcc/ada/libgnat/a-convec.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2019, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2020, 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- --
@@ -31,8 +31,11 @@ with Ada.Containers.Generic_Array_Sort;
 with Ada.Unchecked_Deallocation;
 
 with System; use type System.Address;
+with System.Put_Images;
 
-package body Ada.Containers.Vectors is
+package body Ada.Containers.Vectors with
+  SPARK_Mode => Off
+is
 
    pragma Warnings (Off, "variable ""Busy*"" is not referenced");
    pragma Warnings (Off, "variable ""Lock*"" is not referenced");
@@ -377,6 +380,14 @@ package body Ada.Containers.Vectors is
       J        : Index_Type'Base;  -- first index of items that slide down
 
    begin
+      --  The tampering bits exist to prevent an item from being deleted (or
+      --  otherwise harmfully manipulated) while it is being visited. Query,
+      --  Update, and Iterate increment the busy count on entry, and decrement
+      --  the count on exit. Delete checks the count to determine whether it is
+      --  being called while the associated callback procedure is executing.
+
+      TC_Check (Container.TC);
+
       --  Delete removes items from the vector, the number of which is the
       --  minimum of the specified Count and the items (if any) that exist from
       --  Index to Container.Last. There are no constraints on the specified
@@ -420,14 +431,6 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      --  The tampering bits exist to prevent an item from being deleted (or
-      --  otherwise harmfully manipulated) while it is being visited. Query,
-      --  Update, and Iterate increment the busy count on entry, and decrement
-      --  the count on exit. Delete checks the count to determine whether it is
-      --  being called while the associated callback procedure is executing.
-
-      TC_Check (Container.TC);
-
       --  We first calculate what's available for deletion starting at
       --  Index. Here and elsewhere we use the wider of Index_Type'Base and
       --  Count_Type'Base as the type for intermediate values. (See function
@@ -781,6 +784,8 @@ package body Ada.Containers.Vectors is
          J : Index_Type'Base;
 
       begin
+         TC_Check (Source.TC);
+
          --  The semantics of Merge changed slightly per AI05-0021. It was
          --  originally the case that if Target and Source denoted the same
          --  container object, then the GNAT implementation of Merge did
@@ -803,8 +808,6 @@ package body Ada.Containers.Vectors is
             return;
          end if;
 
-         TC_Check (Source.TC);
-
          Target.Set_Length (Length (Target) + Length (Source));
 
          --  Per AI05-0022, the container implementation is required to detect
@@ -861,10 +864,6 @@ package body Ada.Containers.Vectors is
               "<"          => "<");
 
       begin
-         if Container.Last <= Index_Type'First then
-            return;
-         end if;
-
          --  The exception behavior for the vector container must match that
          --  for the list container, so we check for cursor tampering here
          --  (which will catch more things) instead of for element tampering
@@ -878,6 +877,10 @@ package body Ada.Containers.Vectors is
 
          TC_Check (Container.TC);
 
+         if Container.Last <= Index_Type'First then
+            return;
+         end if;
+
          --  Per AI05-0022, the container implementation is required to detect
          --  element tampering by a generic actual subprogram.
 
@@ -933,6 +936,14 @@ package body Ada.Containers.Vectors is
       Dst          : Elements_Access;  -- new, expanded internal array
 
    begin
+      --  The tampering bits exist to prevent an item from being harmfully
+      --  manipulated while it is being visited. Query, Update, and Iterate
+      --  increment the busy count on entry, and decrement the count on
+      --  exit. Insert checks the count to determine whether it is being called
+      --  while the associated callback procedure is executing.
+
+      TC_Check (Container.TC);
+
       if Checks then
          --  As a precondition on the generic actual Index_Type, the base type
          --  must include Index_Type'Pred (Index_Type'First); this is the value
@@ -1124,14 +1135,6 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      --  The tampering bits exist to prevent an item from being harmfully
-      --  manipulated while it is being visited. Query, Update, and Iterate
-      --  increment the busy count on entry, and decrement the count on
-      --  exit. Insert checks the count to determine whether it is being called
-      --  while the associated callback procedure is executing.
-
-      TC_Check (Container.TC);
-
       --  An internal array has already been allocated, so we must determine
       --  whether there is enough unused storage for the new items.
 
@@ -1595,6 +1598,14 @@ package body Ada.Containers.Vectors is
       Dst          : Elements_Access;  -- new, expanded internal array
 
    begin
+      --  The tampering bits exist to prevent an item from being harmfully
+      --  manipulated while it is being visited. Query, Update, and Iterate
+      --  increment the busy count on entry, and decrement the count on
+      --  exit. Insert checks the count to determine whether it is being called
+      --  while the associated callback procedure is executing.
+
+      TC_Check (Container.TC);
+
       if Checks then
          --  As a precondition on the generic actual Index_Type, the base type
          --  must include Index_Type'Pred (Index_Type'First); this is the value
@@ -1784,14 +1795,6 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      --  The tampering bits exist to prevent an item from being harmfully
-      --  manipulated while it is being visited. Query, Update, and Iterate
-      --  increment the busy count on entry, and decrement the count on
-      --  exit. Insert checks the count to determine whether it is being called
-      --  while the associated callback procedure is executing.
-
-      TC_Check (Container.TC);
-
       --  An internal array has already been allocated, so we must determine
       --  whether there is enough unused storage for the new items.
 
@@ -2297,6 +2300,31 @@ package body Ada.Containers.Vectors is
       end return;
    end Pseudo_Reference;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+   is
+      First_Time : Boolean := True;
+      use System.Put_Images;
+   begin
+      Array_Before (S);
+
+      for X of V loop
+         if First_Time then
+            First_Time := False;
+         else
+            Simple_Array_Between (S);
+         end if;
+
+         Element_Type'Put_Image (S, X);
+      end loop;
+
+      Array_After (S);
+   end Put_Image;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -2446,11 +2474,12 @@ package body Ada.Containers.Vectors is
       New_Item  : Element_Type)
    is
    begin
+      TE_Check (Container.TC);
+
       if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       end if;
 
-      TE_Check (Container.TC);
       Container.Elements.EA (Index) := New_Item;
    end Replace_Element;
 
@@ -2460,6 +2489,8 @@ package body Ada.Containers.Vectors is
       New_Item  : Element_Type)
    is
    begin
+      TE_Check (Container.TC);
+
       if Checks then
          if Position.Container = null then
             raise Constraint_Error with "Position cursor has no element";
@@ -2472,7 +2503,6 @@ package body Ada.Containers.Vectors is
          end if;
       end if;
 
-      TE_Check (Container.TC);
       Container.Elements.EA (Position.Index) := New_Item;
    end Replace_Element;
 
@@ -2940,6 +2970,8 @@ package body Ada.Containers.Vectors is
 
    procedure Swap (Container : in out Vector; I, J : Index_Type) is
    begin
+      TE_Check (Container.TC);
+
       if Checks then
          if I > Container.Last then
             raise Constraint_Error with "I index is out of range";
@@ -2954,8 +2986,6 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      TE_Check (Container.TC);
-
       declare
          EI_Copy : constant Element_Type := Container.Elements.EA (I);
       begin