[Ada] Iterator subtypes

THis patch fixes an omission in the handling of iterators over containers.
The code now handles properly an iterator type that is a subtype of the
type obtained from an instantiation of the predefined iterator interfaces.

Compiling and executing main.adb must yield:

Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
Element_T.F: 42
V.Element (C).F: 42
V.Element (C).F: 42
V.Element (C).F: 42
V.Element (C).F: 42

---
with Ada.Text_Io; use Ada.Text_Io;
with Containers;

procedure Main is

  type Index is range 1 .. 4;
  type Element_T is
    record
      F : Integer := 42;
    end record;

  package Vectors is new Containers.Vectors (Index, Element_T);

  V : Vectors.Vector;

begin

  for E of V loop
    Put_Line ("Element_T.F:" & Integer'Image (E.F));
  end loop;

  for E of reverse V loop
    Put_Line ("Element_T.F:" & Integer'Image (E.F));
  end loop;

  for C in V.Iterate loop
    Put_Line ("V.Element (C).F:" & Integer'Image (V.Element (C).F));
  end loop;
end Main;
---

with Ada.Iterator_Interfaces;

package Containers is

  generic
    type Index is (<>);
    type Element_T is private;
  package Vectors is

    type Vector is tagged private
      with
        Constant_Indexing => Constant_Reference,
        Default_Iterator => Iterate,
        Iterator_Element => Element_T;

    type Cursor is private;

    function Has_Element (Position : Cursor) return Boolean;

    function Element (Container : in Vector; Position : Cursor)
       return Element_T;

    package Vector_Iterator_Interfaces is
       new Ada.Iterator_Interfaces (Cursor, Has_Element);

    subtype Iterator_Class is
       Vector_Iterator_Interfaces.Reversible_Iterator'Class;

    function Iterate (Container : in Vector) return Iterator_Class;

    function Iterate (Container : in Vector; Start : in Cursor)
       return Iterator_Class;

    type Constant_Reference_Type
      (Element : not null access constant Element_T) is private
      with Implicit_Dereference => Element;

    function Constant_Reference
      (Container : aliased in Vector;
       Position  : in Cursor)
       return Constant_Reference_Type;

  private

    type Rep is array (Index) of aliased Element_T;

    type Vector is tagged
      record
        A : aliased Rep;
      end record;

    type Cursor (Going : Boolean := False) is
      record
        case Going is
          when False =>
            null;
          when True =>
            I : Index;
        end case;
      end record;

    type Constant_Reference_Type
      (Element : not null access constant Element_T) is
      record
        null;
      end record;

    type Iterator is new Vector_Iterator_Interfaces.Reversible_Iterator with
      record
        C : Cursor;
      end record;

    function First (Object : Iterator) return Cursor;
    function Next (Object : Iterator; Position : Cursor) return Cursor;

    function Last (Object : Iterator) return Cursor;
    function Previous (Object : Iterator; Position : Cursor) return Cursor;

  end Vectors;

end Containers;
---
package body Containers is
  package body Vectors is

    function Has_Element (Position : Cursor) return Boolean is
    begin
      return Position.Going;
    end Has_Element;

    function Element (Container : in Vector; Position : Cursor)
      return Element_T is
    begin
      return Container.A (Position.I);
    end Element;

    function Iterate (Container : in Vector) return Iterator_Class is
    begin
      return Iterator_Class
         (Iterator'(C => (Going => True, I => Index'First)));
    end Iterate;

    function Iterate (Container : in Vector; Start: in Cursor)
      return Iterator_Class is
    begin
      return Iterator_Class (Iterator'(C => Start));
    end Iterate;

    function Constant_Reference
      (Container : aliased in Vector;
       Position  : in Cursor)
       return Constant_Reference_Type is
    begin
      return (Element => Container.A (Position.I)'Access);
    end Constant_Reference;

    function First (Object : Iterator) return Cursor is
    begin
      return (Going => True, I => Index'First);
    end First;

    function Next (Object : Iterator; Position : Cursor) return Cursor is
    begin
      if Position.I /= Index'Last then
        return (Going => True, I => Index'Succ (Position.I));
      else
        return (Going => False);
      end if;
    end Next;

    function Last (Object : Iterator) return Cursor is
    begin
      return (Going => True, I => Index'Last);
    end Last;

    function Previous (Object : Iterator; Position : Cursor) return Cursor is
    begin
      if Position.I /= Index'First then
        return (Going => True, I => Index'Pred (Position.I));
      else
        return (Going => False);
      end if;
    end Previous;

  end Vectors;
end Containers;

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_Iterator, Is_Reversible_iterator): Use
	root type to determine whether the type is a descendant of the
	corresponding interface type, so take into account multiple
	levels of subtypes and derivations.