[Ada] Spurious errors with generalized iterators

This patch fixes some spurious errors in a generalized iterator over a user-
defined container, when the first parameter of the Iterate function
is an access parameter, and the iterator type is locally derived.

Executing;

   gnatmake -q ausprobieren.adb
   ausprobieren

must yield:

    5
    999
    5
    999

---
with Ada.Text_IO;
use  Ada.Text_IO;
with Circularly_Linked_Lists;
procedure Ausprobieren is

  package Lists is new Circularly_Linked_Lists (Integer);
  use Lists;

  Elem1 : aliased Integer := 5;
  List: aliased Circularly_Linked_List := Init (Elem1);
  Elem2 : aliased Integer := 999;
begin
  List.Insert (Elem2);
  for Cursor in List.Iterate loop
    Put_Line (Integer'Image (List (Cursor)));
  end loop;

  for Elm of List loop
     Put_Line (Integer'Image (Elm));
  end loop;
end Ausprobieren; 
---
with Ada.Iterator_Interfaces;

generic

  type Element_Type is private;

package Circularly_Linked_Lists is

  type Circularly_Linked_List is tagged private
    with Default_Iterator  => Iterate,
         Iterator_Element  => Element_Type,
         Variable_Indexing => Acc;

  type Accessor (Elem: not null access Element_Type) is limited null record
    with Implicit_Dereference => Elem;

  type Cursor is private;
  function Init (X : aliased ELement_Type) return Circularly_Linked_List;
  function Has_Element (Position: Cursor) return Boolean;

  function Acc (CLL     : in out Circularly_Linked_List;
                Position: in     Cursor) return Accessor;
  package Iterator_Interfaces is new
      Ada.Iterator_Interfaces (Cursor, Has_Element);

  type Forward_Iterator (CLL: not null access Circularly_Linked_List) is new
      Iterator_Interfaces.Forward_Iterator with null record;

  overriding function First (Object  : Forward_Iterator) return Cursor;
  overriding function Next  (Object  : Forward_Iterator;
                             Position: Cursor          ) return Cursor;

   function Iterate1 (CLL: not null access Circularly_Linked_List'Class)
       return Forward_Iterator;

  function Iterate (CLL: not null access Circularly_Linked_List )
        return Forward_Iterator'Class;

  procedure Insert
      (Object : in out Circularly_Linked_List; Thing : aliased Element_Type);
private

  type CLL_Ptr is access all Circularly_Linked_List;

  type Ptr is access all Element_Type;

  type Cursor is record
    Current: CLL_Ptr;
  end record;

  type Circularly_Linked_List is tagged record
    Next, Prev: CLL_Ptr;
    It  : Ptr;
  end record;
end Circularly_Linked_Lists;
---
package body Circularly_Linked_Lists is

  function Init (X : aliased ELement_Type) return Circularly_Linked_List is
  begin
     return (null, null, X'Unrestricted_Access);
  end;
  function Has_Element (Position: Cursor) return Boolean is
  begin
      return  Position.Current /= null and then Position.Current.It /= null;
  end Has_Element;

  function Acc (CLL     : in out Circularly_Linked_List;
                Position: in     Cursor) return Accessor is
  begin
     return (Elem => Position.Current.It);
  end;

   function Iterate1 (CLL: not null access Circularly_Linked_List'Class)
       return Forward_Iterator
 is
  begin
     return forward_iterator'(Iterator_Interfaces.Forward_Iterator with
        CLL => CLL.all'Unrestricted_Access);
  end;

 function Iterate (CLL: not null access Circularly_Linked_List )
    return Forward_Iterator'Class
 is
  begin
     return forward_iterator'(Iterator_Interfaces.Forward_Iterator with
        CLL => CLL);
  end;

  overriding function First (Object  : Forward_Iterator) return Cursor is
  begin
     return (Current => Object.CLL.all'Unchecked_Access);
  end;
  overriding function Next  (Object  : Forward_Iterator;
                             Position: Cursor          ) return Cursor is
  begin
     return (Current => Position.Current.Next);
  end;

  procedure Insert
     (Object : in out Circularly_Linked_List; Thing : aliased Element_Type) is
  begin
     Object.Next := new Circularly_Linked_List'
       (Prev => Object'Unchecked_access,
        Next => Object.Next,
        It => Thing'Unrestricted_Access);
  end;
end Circularly_Linked_Lists;

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

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Denotes_Iterator): Use root type to determine
	whether the ultimate ancestor is the predefined iterator
	interface pakage.
	* exp_ch5.adb (Expand_Iterator_Over_Container): simplify code
	and avoid reuse of Pack local variable.

[Ada] Spurious errors with generalized iterators

Commit Message

Patch