[multiple changes]

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

	* checks.adb (Apply_Predicate_Check): Update the comment associated
	with the call to Check_Expression_Against_Static_Predicate.
	* sem_ch3.adb (Analyze_Object_Declaration): Update the comment
	associated with the call to Check_Expression_Against_Static_Predicate.
	* sem_util.adb (Check_Expression_Against_Static_Predicate):
	Broaden the check from a static expression to an expression with
	a known value at compile time.
	* sem_util.ads (Check_Expression_Against_Static_Predicate): Update
	comment on usage.

2013-04-25  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, cases Position,
	First_Bit, and Last_Bit): Fix incorrect test in implementation of
	RM 2005 13.5.2(3/2).

2013-04-25  Claire Dross  <dross@adacore.com>

	* a-cfhase.adb, a-cfhase.ads, a-cforma.adb, a-cforma.ads, a-cfhama.adb,
	a-cfhama.ads, a-cforse.adb, a-cforse.ads, a-cofove.adb, a-cofove.ads
	(Query_Element): Removed.
	(Update_Element): Removed.
	(Insert): The version with no New_Item specified is removed.
	(Iterate): Removed.
	(Write): Removed.
	(Read): Removed.
	Every check of fields Busy and Lock has been removed.

2013-04-25  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Contract_Cases): Remove
	call to S14_Pragma (Find_Related_Subprogram): Require proper
	placement in subprogram body (Find_Related_Subprogram): Detect
	duplicates for all cases (Find_Related_Subprogram): Handle case
	of spec nested inside body.

From-SVN: r198297

1 files changed, 1 insertions, 306 deletions

diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index d5d73e2..539a0a8 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-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- --
@@ -295,11 +295,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Container.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
-      end if;
-
       pragma Assert (Vet (Container, Position), "bad cursor in Delete");
 
       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
@@ -333,11 +328,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
-      end if;
-
       if Src_Length >= Target.Length then
          Tgt_Node := HT_Ops.First (Target);
          while Tgt_Node /= 0 loop
@@ -572,9 +562,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       end;
    end Equivalent_Elements;
 
-   --  What does the following comment signify???
-   --  NOT MODIFIED
-
    ---------------------
    -- Equivalent_Keys --
    ---------------------
@@ -700,10 +687,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       Insert (Container, New_Item, Position, Inserted);
 
       if not Inserted then
-         if Container.Lock > 0 then
-            raise Program_Error with
-              "attempt to tamper with cursors (set is locked)";
-         end if;
 
          Container.Nodes (Position.Node).Element := New_Item;
       end if;
@@ -804,11 +787,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
-      end if;
-
       Tgt_Node := HT_Ops.First (Target);
       while Tgt_Node /= 0 loop
          if Find (Source, TN (Tgt_Node).Element).Node /= 0 then
@@ -930,48 +908,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       return True;
    end Is_Subset;
 
-   -------------
-   -- Iterate --
-   -------------
-
-   procedure Iterate
-     (Container : Set;
-      Process   :
-      not null access procedure (Container : Set; Position : Cursor))
-   is
-      procedure Process_Node (Node : Count_Type);
-      pragma Inline (Process_Node);
-
-      procedure Iterate is
-        new HT_Ops.Generic_Iteration (Process_Node);
-
-      ------------------
-      -- Process_Node --
-      ------------------
-
-      procedure Process_Node (Node : Count_Type) is
-      begin
-         Process (Container, (Node => Node));
-      end Process_Node;
-
-      B : Natural renames Container'Unrestricted_Access.Busy;
-
-   --  Start of processing for Iterate
-
-   begin
-      B := B + 1;
-
-      begin
-         Iterate (Container);
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
-
-      B := B - 1;
-   end Iterate;
-
    ----------
    -- Left --
    ----------
@@ -1029,11 +965,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
            "Source length exceeds Target capacity";
       end if;
 
-      if Source.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors of Source (list is busy)";
-      end if;
-
       Clear (Target);
 
       if Source.Length = 0 then
@@ -1117,103 +1048,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       return False;
    end Overlap;
 
-   -------------------
-   -- Query_Element --
-   -------------------
-
-   procedure Query_Element
-     (Container : in out Set;
-      Position  : Cursor;
-      Process   : not null access procedure (Element : Element_Type))
-   is
-   begin
-      if not Has_Element (Container, Position) then
-         raise Constraint_Error with
-           "Position cursor of Query_Element has no element";
-      end if;
-
-      pragma Assert (Vet (Container, Position), "bad cursor in Query_Element");
-
-      declare
-         B : Natural renames Container.Busy;
-         L : Natural renames Container.Lock;
-
-      begin
-         B := B + 1;
-         L := L + 1;
-
-         begin
-            Process (Container.Nodes (Position.Node).Element);
-         exception
-            when others =>
-               L := L - 1;
-               B := B - 1;
-               raise;
-         end;
-
-         L := L - 1;
-         B := B - 1;
-      end;
-   end Query_Element;
-
-   ----------
-   -- Read --
-   ----------
-
-   procedure Read
-     (Stream    : not null access Root_Stream_Type'Class;
-      Container : out Set)
-   is
-      function Read_Node (Stream : not null access Root_Stream_Type'Class)
-                          return Count_Type;
-
-      procedure Read_Nodes is
-        new HT_Ops.Generic_Read (Read_Node);
-
-      ---------------
-      -- Read_Node --
-      ---------------
-
-      function Read_Node (Stream : not null access Root_Stream_Type'Class)
-                          return Count_Type
-      is
-         procedure Read_Element (Node : in out Node_Type);
-         pragma Inline (Read_Element);
-
-         procedure Allocate is new Generic_Allocate (Read_Element);
-
-         ------------------
-         -- Read_Element --
-         ------------------
-
-         procedure Read_Element (Node : in out Node_Type) is
-         begin
-            Element_Type'Read (Stream, Node.Element);
-         end Read_Element;
-
-         Node : Count_Type;
-
-      --  Start of processing for Read_Node
-
-      begin
-         Allocate (Container, Node);
-         return Node;
-      end Read_Node;
-
-   --  Start of processing for Read
-
-   begin
-      Read_Nodes (Stream, Container);
-   end Read;
-
-   procedure Read
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : out Cursor)
-   is
-   begin
-      raise Program_Error with "attempt to stream set cursor";
-   end Read;
-
    -------------
    -- Replace --
    -------------
@@ -1230,11 +1064,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
            "attempt to replace element not in set";
       end if;
 
-      if Container.Lock > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (set is locked)";
-      end if;
-
       Container.Nodes (Node).Element := New_Item;
    end Replace;
 
@@ -1391,11 +1220,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
-      end if;
-
       Iterate (Source);
    end Symmetric_Difference;
 
@@ -1475,10 +1299,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
-      end if;
       Iterate (Source);
    end Union;
 
@@ -1557,47 +1377,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
       end;
    end Vet;
 
-   -----------
-   -- Write --
-   -----------
-
-   procedure Write
-     (Stream    : not null access Root_Stream_Type'Class;
-      Container : Set)
-   is
-      procedure Write_Node
-        (Stream : not null access Root_Stream_Type'Class;
-         Node   : Node_Type);
-      pragma Inline (Write_Node);
-
-      procedure Write_Nodes is
-        new HT_Ops.Generic_Write (Write_Node);
-
-      ----------------
-      -- Write_Node --
-      ----------------
-
-      procedure Write_Node
-        (Stream : not null access Root_Stream_Type'Class;
-         Node   : Node_Type)
-      is
-      begin
-         Element_Type'Write (Stream, Node.Element);
-      end Write_Node;
-
-      --  Start of processing for Write
-
-   begin
-      Write_Nodes (Stream, Container);
-   end Write;
-
-   procedure Write
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : Cursor)
-   is
-   begin
-      raise Program_Error with "attempt to stream set cursor";
-   end Write;
    package body Generic_Keys is
 
       -----------------------
@@ -1752,90 +1531,6 @@ package body Ada.Containers.Formal_Hashed_Sets is
          Replace_Element (Container, Node, New_Item);
       end Replace;
 
-      -----------------------------------
-      -- Update_Element_Preserving_Key --
-      -----------------------------------
-
-      procedure Update_Element_Preserving_Key
-        (Container : in out Set;
-         Position  : Cursor;
-         Process   : not null access
-                       procedure (Element : in out Element_Type))
-      is
-         Indx : Hash_Type;
-         N    : Nodes_Type renames Container.Nodes;
-
-      begin
-         if Position.Node = 0 then
-            raise Constraint_Error with
-              "Position cursor equals No_Element";
-         end if;
-
-         pragma Assert
-           (Vet (Container, Position),
-            "bad cursor in Update_Element_Preserving_Key");
-
-      --  Record bucket now, in case key is changed
-
-         Indx := HT_Ops.Index (Container.Buckets, N (Position.Node));
-
-         declare
-            E : Element_Type renames N (Position.Node).Element;
-            K : constant Key_Type := Key (E);
-            B : Natural renames Container.Busy;
-            L : Natural renames Container.Lock;
-
-         begin
-            B := B + 1;
-            L := L + 1;
-
-            begin
-               Process (E);
-            exception
-               when others =>
-                  L := L - 1;
-                  B := B - 1;
-                  raise;
-            end;
-
-            L := L - 1;
-            B := B - 1;
-
-            if Equivalent_Keys (K, Key (E)) then
-               pragma Assert (Hash (K) = Hash (E));
-               return;
-            end if;
-         end;
-
-         --  Key was modified, so remove this node from set
-
-         if Container.Buckets (Indx) = Position.Node then
-            Container.Buckets (Indx) := N (Position.Node).Next;
-
-         else
-            declare
-               Prev : Count_Type := Container.Buckets (Indx);
-
-            begin
-               while N (Prev).Next /= Position.Node loop
-                  Prev := N (Prev).Next;
-
-                  if Prev = 0 then
-                     raise Program_Error with
-                       "Position cursor is bad (node not found)";
-                  end if;
-               end loop;
-
-               N (Prev).Next := N (Position.Node).Next;
-            end;
-         end if;
-
-         Container.Length := Container.Length - 1;
-         Free (Container, Position.Node);
-
-         raise Program_Error with "key was modified";
-      end Update_Element_Preserving_Key;
-
    end Generic_Keys;
 
 end Ada.Containers.Formal_Hashed_Sets;