[multiple changes]

2017-09-06  Raphael Amiard  <amiard@adacore.com>

	* a-chtgop.ads, a-chtgop.adb: Add versions of First and Next with
	Position parameter. If supplied, use it to provide efficient iteration.
	* a-cohase.ads, a-cohase.adb, a-cihama.ads, a-cihama.adb,
	a-cohama.ads, a-cohama.adb: Add/Use Position to provide efficient
	iteration.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Build_Allocate_Deallocate_Proc): If the
	designated type is class-wide and the expression is an unchecked
	conversion, preserve the conversion when checking the tag of the
	designated object, to prevent spurious semantic errors when the
	expression in the conversion has an untagged type (for example
	an address attribute).

From-SVN: r251757

10 files changed, 162 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f6f19dc..268eb13 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2017-09-06  Raphael Amiard  <amiard@adacore.com>
+
+	* a-chtgop.ads, a-chtgop.adb: Add versions of First and Next with
+	Position parameter. If supplied, use it to provide efficient iteration.
+	* a-cohase.ads, a-cohase.adb, a-cihama.ads, a-cihama.adb,
+	a-cohama.ads, a-cohama.adb: Add/Use Position to provide efficient
+	iteration.
+
+2017-09-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.adb (Build_Allocate_Deallocate_Proc): If the
+	designated type is class-wide and the expression is an unchecked
+	conversion, preserve the conversion when checking the tag of the
+	designated object, to prevent spurious semantic errors when the
+	expression in the conversion has an untagged type (for example
+	an address attribute).
+
 2017-09-06  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve_Entry_Call): Check whether a protected
diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb
index 53b564f..2b85b29 100644
--- a/gcc/ada/a-chtgop.adb
+++ b/gcc/ada/a-chtgop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -300,21 +300,30 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    -- First --
    -----------
 
-   function First (HT : Hash_Table_Type) return Node_Access is
-      Indx : Hash_Type;
+   function First
+     (HT       : Hash_Table_Type) return Node_Access
+   is
+      Dummy : Hash_Type;
+   begin
+      return First (HT, Dummy);
+   end First;
 
+   function First
+     (HT       : Hash_Table_Type;
+      Position : out Hash_Type) return Node_Access is
    begin
       if HT.Length = 0 then
+         Position := Hash_Type'Last;
          return null;
       end if;
 
-      Indx := HT.Buckets'First;
+      Position := HT.Buckets'First;
       loop
-         if HT.Buckets (Indx) /= null then
-            return HT.Buckets (Indx);
+         if HT.Buckets (Position) /= null then
+            return HT.Buckets (Position);
          end if;
 
-         Indx := Indx + 1;
+         Position := Position + 1;
       end loop;
    end First;
 
@@ -589,24 +598,35 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    ----------
 
    function Next
-     (HT   : aliased in out Hash_Table_Type;
-      Node : Node_Access) return Node_Access
+     (HT            : aliased in out Hash_Table_Type;
+      Node          : Node_Access;
+      Position : in out Hash_Type) return Node_Access
    is
       Result : Node_Access;
       First  : Hash_Type;
 
    begin
+      --  First, check if the node has other nodes chained to it
       Result := Next (Node);
 
       if Result /= null then
          return Result;
       end if;
 
-      First := Checked_Index (HT, Node) + 1;
+      --  Check if we were supplied a position for Node, from which we
+      --  can start iteration on the buckets.
+
+      if Position /= Hash_Type'Last then
+         First := Position + 1;
+      else
+         First := Checked_Index (HT, Node) + 1;
+      end if;
+
       for Indx in First .. HT.Buckets'Last loop
          Result := HT.Buckets (Indx);
 
          if Result /= null then
+            Position := Indx;
             return Result;
          end if;
       end loop;
@@ -614,6 +634,15 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       return null;
    end Next;
 
+   function Next
+     (HT            : aliased in out Hash_Table_Type;
+      Node          : Node_Access) return Node_Access
+   is
+      Pos : Hash_Type := Hash_Type'Last;
+   begin
+      return Next (HT, Node, Pos);
+   end Next;
+
    ----------------------
    -- Reserve_Capacity --
    ----------------------
diff --git a/gcc/ada/a-chtgop.ads b/gcc/ada/a-chtgop.ads
index 1b865dc..ba68b2d 100644
--- a/gcc/ada/a-chtgop.ads
+++ b/gcc/ada/a-chtgop.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -142,17 +142,31 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
       X  : Node_Access);
    --  Removes node X from the hash table without deallocating the node
 
-   function First (HT : Hash_Table_Type) return Node_Access;
+   function First
+     (HT       : Hash_Table_Type) return Node_Access;
+   function First
+     (HT       : Hash_Table_Type;
+      Position : out Hash_Type) return Node_Access;
    --  Returns the head of the list in the first (lowest-index) non-empty
-   --  bucket.
+   --  bucket. Position will be the index of the bucket of the first node.
+   --  It is provided so that clients can implement efficient iterators.
 
    function Next
      (HT   : aliased in out Hash_Table_Type;
       Node : Node_Access) return Node_Access;
+   function Next
+     (HT       : aliased in out Hash_Table_Type;
+      Node     : Node_Access;
+      Position : in out Hash_Type) return Node_Access;
    --  Returns the node that immediately follows Node. This corresponds to
    --  either the next node in the same bucket, or (if Node is the last node in
    --  its bucket) the head of the list in the first non-empty bucket that
    --  follows.
+   --
+   --  If Node_Position is supplied, then it will be used as a starting point
+   --  for iteration (Node_Position must be the index of Node's buckets). If it
+   --  is not supplied, it will be recomputed. It is provided so that clients
+   --  can implement efficient iterators.
 
    generic
       with procedure Process (Node : Node_Access);
diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index 3c05aac..0d84379 100644
--- a/gcc/ada/a-cihama.adb
+++ b/gcc/ada/a-cihama.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -506,7 +506,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Node);
+      return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
    end Find;
 
    --------------------
@@ -537,12 +537,13 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    -----------
 
    function First (Container : Map) return Cursor is
-      Node : constant Node_Access := HT_Ops.First (Container.HT);
+      Pos  : Hash_Type;
+      Node : constant Node_Access := HT_Ops.First (Container.HT, Pos);
    begin
       if Node = null then
          return No_Element;
       else
-         return Cursor'(Container'Unrestricted_Access, Node);
+         return Cursor'(Container'Unrestricted_Access, Node, Pos);
       end if;
    end First;
 
@@ -781,7 +782,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
       procedure Process_Node (Node : Node_Access) is
       begin
-         Process (Cursor'(Container'Unrestricted_Access, Node));
+         Process
+           (Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last));
       end Process_Node;
 
       Busy : With_Busy (Container.HT.TC'Unrestricted_Access);
@@ -860,6 +862,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    end Next;
 
    function Next (Position : Cursor) return Cursor is
+      Node : Node_Access;
+      Pos  : Hash_Type;
    begin
       if Position.Node = null then
          return No_Element;
@@ -873,16 +877,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
       pragma Assert (Vet (Position), "Position cursor of Next is bad");
 
-      declare
-         HT   : Hash_Table_Type renames Position.Container.HT;
-         Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
-      begin
-         if Node = null then
-            return No_Element;
-         else
-            return Cursor'(Position.Container, Node);
-         end if;
-      end;
+      Pos := Position.Position;
+      Node := HT_Ops.Next (Position.Container.HT, Position.Node, Pos);
+
+      if Node = null then
+         return No_Element;
+      else
+         return Cursor'(Position.Container, Node, Pos);
+      end if;
    end Next;
 
    function Next (Object : Iterator; Position : Cursor) return Cursor is
diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads
index 5ad6588..dad3475 100644
--- a/gcc/ada/a-cihama.ads
+++ b/gcc/ada/a-cihama.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -354,6 +354,7 @@ private
    type Cursor is record
       Container : Map_Access;
       Node      : Node_Access;
+      Position  : Hash_Type := Hash_Type'Last;
    end record;
 
    procedure Write
@@ -433,7 +434,8 @@ private
 
    Empty_Map : constant Map := (Controlled with others => <>);
 
-   No_Element : constant Cursor := (Container => null, Node => null);
+   No_Element : constant Cursor :=
+     (Container => null, Node => null, Position  => Hash_Type'Last);
 
    type Iterator is new Limited_Controlled and
      Map_Iterator_Interfaces.Forward_Iterator with
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index 20a48b6..d4a0d59 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -462,7 +462,7 @@ package body Ada.Containers.Hashed_Maps is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Node);
+      return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
    end Find;
 
    --------------------
@@ -493,14 +493,14 @@ package body Ada.Containers.Hashed_Maps is
    -----------
 
    function First (Container : Map) return Cursor is
-      Node : constant Node_Access := HT_Ops.First (Container.HT);
-
+      Pos  : Hash_Type;
+      Node : constant Node_Access := HT_Ops.First (Container.HT, Pos);
    begin
       if Node = null then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Node);
+      return Cursor'(Container'Unrestricted_Access, Node, Pos);
    end First;
 
    function First (Object : Iterator) return Cursor is
@@ -710,7 +710,8 @@ package body Ada.Containers.Hashed_Maps is
 
       procedure Process_Node (Node : Node_Access) is
       begin
-         Process (Cursor'(Container'Unrestricted_Access, Node));
+         Process
+           (Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last));
       end Process_Node;
 
       Busy : With_Busy (Container.HT.TC'Unrestricted_Access);
@@ -779,6 +780,10 @@ package body Ada.Containers.Hashed_Maps is
    end Next;
 
    function Next (Position : Cursor) return Cursor is
+      Node    : Node_Access := null;
+
+      Pos : Hash_Type;
+      --  Position of cursor's element in the map buckets.
    begin
       if Position.Node = null then
          return No_Element;
@@ -786,17 +791,16 @@ package body Ada.Containers.Hashed_Maps is
 
       pragma Assert (Vet (Position), "bad cursor in function Next");
 
-      declare
-         HT   : Hash_Table_Type renames Position.Container.HT;
-         Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
+      --  Initialize to current position, so that HT_Ops.Next can use it
+      Pos := Position.Position;
 
-      begin
-         if Node = null then
-            return No_Element;
-         end if;
+      Node := HT_Ops.Next (Position.Container.HT, Position.Node, Pos);
 
-         return Cursor'(Position.Container, Node);
-      end;
+      if Node = null then
+         return No_Element;
+      else
+         return Cursor'(Position.Container, Node, Pos);
+      end if;
    end Next;
 
    procedure Next (Position : in out Cursor) is
diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads
index 7443b54..8a6f8c2 100644
--- a/gcc/ada/a-cohama.ads
+++ b/gcc/ada/a-cohama.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -359,7 +359,14 @@ private
 
    type Cursor is record
       Container : Map_Access;
+      --  Access to this cursor's container
+
       Node      : Node_Access;
+      --  Access to the node pointed to by this cursor
+
+      Position  : Hash_Type := Hash_Type'Last;
+      --  Position of the node in the buckets of the container. If this is
+      --  equal to Hash_Type'Last, then it will not be used.
    end record;
 
    procedure Read
@@ -442,7 +449,8 @@ private
 
    Empty_Map : constant Map := (Controlled with others => <>);
 
-   No_Element : constant Cursor := (Container => null, Node => null);
+   No_Element : constant Cursor := (Container => null, Node => null,
+                                    Position  => Hash_Type'Last);
 
    type Iterator is new Limited_Controlled and
      Map_Iterator_Interfaces.Forward_Iterator with
diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb
index 5f31e58..eab8a40 100644
--- a/gcc/ada/a-cohase.adb
+++ b/gcc/ada/a-cohase.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -595,7 +595,7 @@ package body Ada.Containers.Hashed_Sets is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Node);
+      return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
    end Find;
 
    --------------------
@@ -657,14 +657,14 @@ package body Ada.Containers.Hashed_Sets is
    -----------
 
    function First (Container : Set) return Cursor is
-      Node : constant Node_Access := HT_Ops.First (Container.HT);
-
+      Pos  : Hash_Type;
+      Node : constant Node_Access := HT_Ops.First (Container.HT, Pos);
    begin
       if Node = null then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Node);
+      return Cursor'(Container'Unrestricted_Access, Node, Pos);
    end First;
 
    function First (Object : Iterator) return Cursor is
@@ -989,7 +989,8 @@ package body Ada.Containers.Hashed_Sets is
 
       procedure Process_Node (Node : Node_Access) is
       begin
-         Process (Cursor'(Container'Unrestricted_Access, Node));
+         Process
+           (Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last));
       end Process_Node;
 
       Busy : With_Busy (Container.HT.TC'Unrestricted_Access);
@@ -1038,6 +1039,8 @@ package body Ada.Containers.Hashed_Sets is
    end Next;
 
    function Next (Position : Cursor) return Cursor is
+      Node : Node_Access;
+      Pos  : Hash_Type;
    begin
       if Position.Node = null then
          return No_Element;
@@ -1045,17 +1048,14 @@ package body Ada.Containers.Hashed_Sets is
 
       pragma Assert (Vet (Position), "bad cursor in Next");
 
-      declare
-         HT   : Hash_Table_Type renames Position.Container.HT;
-         Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
+      Pos := Position.Position;
+      Node := HT_Ops.Next (Position.Container.HT, Position.Node, Pos);
 
-      begin
-         if Node = null then
-            return No_Element;
-         end if;
+      if Node = null then
+         return No_Element;
+      end if;
 
-         return Cursor'(Position.Container, Node);
-      end;
+      return Cursor'(Position.Container, Node, Pos);
    end Next;
 
    procedure Next (Position : in out Cursor) is
@@ -1957,7 +1957,8 @@ package body Ada.Containers.Hashed_Sets is
          if Node = null then
             return No_Element;
          else
-            return Cursor'(Container'Unrestricted_Access, Node);
+            return Cursor'
+              (Container'Unrestricted_Access, Node, Hash_Type'Last);
          end if;
       end Find;
 
diff --git a/gcc/ada/a-cohase.ads b/gcc/ada/a-cohase.ads
index 681087a..79e3400 100644
--- a/gcc/ada/a-cohase.ads
+++ b/gcc/ada/a-cohase.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -528,6 +528,7 @@ private
    type Cursor is record
       Container : Set_Access;
       Node      : Node_Access;
+      Position  : Hash_Type := Hash_Type'Last;
    end record;
 
    procedure Write
@@ -588,7 +589,8 @@ private
 
    Empty_Set : constant Set := (Controlled with others => <>);
 
-   No_Element : constant Cursor := (Container => null, Node => null);
+   No_Element : constant Cursor :=
+     (Container => null, Node => null, Position => Hash_Type'Last);
 
    type Iterator is new Limited_Controlled and
      Set_Iterator_Interfaces.Forward_Iterator with
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8270ea5..8098a93 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -871,11 +871,25 @@ package body Exp_Util is
 
                   --    Temp'Tag
 
+                  --  If the object is an unchecked conversion (typically to
+                  --  an access to class-wide type), we must preserve the
+                  --  conversion to ensure that the object is seen as tagged
+                  --  in the code that follows.
+
                   else
-                     Param :=
-                       Make_Attribute_Reference (Loc,
-                         Prefix         => Relocate_Node (Temp),
-                         Attribute_Name => Name_Tag);
+                     if
+                       Nkind (Parent (Temp)) = N_Unchecked_Type_Conversion
+                     then
+                        Param :=
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => Relocate_Node (Parent (Temp)),
+                            Attribute_Name => Name_Tag);
+                     else
+                        Param :=
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => Relocate_Node (Temp),
+                            Attribute_Name => Name_Tag);
+                     end if;
                   end if;
 
                   --  Generate: