[Ada] Ada2020: AI12-0110 Tampering checks are performed first

2020-06-17  Bob Duff  <duff@adacore.com>

gcc/ada/

	* libgnat/a-cbdlli.adb, libgnat/a-cbhama.adb,
	libgnat/a-cbhase.adb, libgnat/a-cbmutr.adb,
	libgnat/a-cborma.adb, libgnat/a-cborse.adb,
	libgnat/a-cdlili.adb, libgnat/a-chtgbk.adb,
	libgnat/a-chtgke.adb, libgnat/a-cidlli.adb,
	libgnat/a-cihama.adb, libgnat/a-cihase.adb,
	libgnat/a-cimutr.adb, libgnat/a-ciorma.adb,
	libgnat/a-ciorse.adb, libgnat/a-cobove.adb,
	libgnat/a-cohama.adb, libgnat/a-cohase.adb,
	libgnat/a-coinve.adb, libgnat/a-comutr.adb,
	libgnat/a-convec.adb, libgnat/a-coorma.adb,
	libgnat/a-coorse.adb, libgnat/a-crbtgk.adb,
	libgnat/a-crbtgo.adb, libgnat/a-rbtgso.adb: Move tampering
	checks earlier.

1 files changed, 33 insertions, 38 deletions

diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb
index d8ed1f8..fe94ea5 100644
--- a/gcc/ada/libgnat/a-cobove.adb
+++ b/gcc/ada/libgnat/a-cobove.adb
@@ -483,6 +483,8 @@ package body Ada.Containers.Bounded_Vectors is
       Off      : Count_Type'Base;  -- Index expressed as offset from IT'First
 
    begin
+      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
@@ -532,8 +534,6 @@ package body Ada.Containers.Bounded_Vectors is
       --  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
@@ -636,15 +636,6 @@ package body Ada.Containers.Bounded_Vectors is
       Count     : Count_Type := 1)
    is
    begin
-      --  It is not permitted to delete items while the container is busy (for
-      --  example, we're in the middle of a passive iteration). However, we
-      --  always treat deleting 0 items as a no-op, even when we're busy, so we
-      --  simply return without checking.
-
-      if Count = 0 then
-         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
@@ -654,6 +645,10 @@ package body Ada.Containers.Bounded_Vectors is
 
       TC_Check (Container.TC);
 
+      if Count = 0 then
+         return;
+      end if;
+
       --  There is no restriction on how large Count can be when deleting
       --  items. If it is equal or greater than the current length, then this
       --  is equivalent to clearing the vector. (In particular, there's no need
@@ -882,6 +877,8 @@ package body Ada.Containers.Bounded_Vectors is
             return;
          end if;
 
+         TC_Check (Source.TC);
+
          if Checks and then Target'Address = Source'Address then
             raise Program_Error with
               "Target and Source denote same non-empty container";
@@ -892,8 +889,6 @@ package body Ada.Containers.Bounded_Vectors is
             return;
          end if;
 
-         TC_Check (Source.TC);
-
          I := Target.Length;
          Target.Set_Length (I + Source.Length);
 
@@ -1021,6 +1016,14 @@ package body Ada.Containers.Bounded_Vectors is
       J     : Count_Type'Base;  -- scratch
 
    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);
+
       --  As a precondition on the generic actual Index_Type, the base type
       --  must include Index_Type'Pred (Index_Type'First); this is the value
       --  that Container.Last assumes when the vector is empty. However, we do
@@ -1176,14 +1179,6 @@ package body Ada.Containers.Bounded_Vectors is
          raise Constraint_Error with "Count is out of range";
       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);
-
       if Checks and then New_Length > Container.Capacity then
          raise Capacity_Error with "New length is larger than capacity";
       end if;
@@ -1491,6 +1486,14 @@ package body Ada.Containers.Bounded_Vectors is
       J     : Count_Type'Base;  -- scratch
 
    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);
+
       --  As a precondition on the generic actual Index_Type, the base type
       --  must include Index_Type'Pred (Index_Type'First); this is the value
       --  that Container.Last assumes when the vector is empty. However, we do
@@ -1646,14 +1649,6 @@ package body Ada.Containers.Bounded_Vectors is
          raise Constraint_Error with "Count is out of range";
       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 need to check
       --  whether there is enough unused storage for the new items.
 
@@ -1937,14 +1932,14 @@ package body Ada.Containers.Bounded_Vectors is
          return;
       end if;
 
+      TC_Check (Target.TC);
+      TC_Check (Source.TC);
+
       if Checks and then Target.Capacity < Source.Length then
          raise Capacity_Error  -- ???
            with "Target capacity is less than Source length";
       end if;
 
-      TC_Check (Target.TC);
-      TC_Check (Source.TC);
-
       --  Clear Target now, in case element assignment fails
 
       Target.Last := No_Index;
@@ -2222,12 +2217,12 @@ package body Ada.Containers.Bounded_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 (To_Array_Index (Index)) := New_Item;
    end Replace_Element;
 
@@ -2237,6 +2232,8 @@ package body Ada.Containers.Bounded_Vectors is
       New_Item  : Element_Type)
    is
    begin
+      TE_Check (Container.TC);
+
       if Checks and then Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
       end if;
@@ -2250,8 +2247,6 @@ package body Ada.Containers.Bounded_Vectors is
          raise Constraint_Error with "Position cursor is out of range";
       end if;
 
-      TE_Check (Container.TC);
-
       Container.Elements (To_Array_Index (Position.Index)) := New_Item;
    end Replace_Element;
 
@@ -2425,6 +2420,8 @@ package body Ada.Containers.Bounded_Vectors is
       E : Elements_Array renames Container.Elements;
 
    begin
+      TE_Check (Container.TC);
+
       if Checks and then I > Container.Last then
          raise Constraint_Error with "I index is out of range";
       end if;
@@ -2437,8 +2434,6 @@ package body Ada.Containers.Bounded_Vectors is
          return;
       end if;
 
-      TE_Check (Container.TC);
-
       declare
          EI_Copy : constant Element_Type := E (To_Array_Index (I));
       begin