diff mbox

[Ada] Iterable aspect for an integer type

Message ID 20151113113124.GA102727@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 13, 2015, 11:31 a.m. UTC 
This patch fixes a spurious error on an iterator loop over an integer type
on which the Iterable aspect has been specified. Analysis of the loop uses
the base type to find the required primitive operations, but the signature
of the First primitive and others uses the first subtype instead.


Executing

    gnatmake -q vect1
    vect1

must yield:

iteration over cursors
 0
 1
 2
 3
 4
iteration over elements
 0
 1
 2
 3
 4

---
with Text_IO; use Text_IO;
procedure Vect1 is
  package Iter is
  type Vector_Id is new Natural with
    Iterable => (First => First,
                 Next  => Next,
                 Has_Element => Has_Element,
                 Element => Element);

  type Cursor is new Natural;

  function First (Vector : Vector_Id) return Cursor;
  function Next (Vector : Vector_Id; Position : Cursor) return Cursor;
  function Has_Element (Vector : Vector_Id; Position : Cursor) return Boolean;
  function Element (Vector : Vector_Id; Position : Cursor) return Natural;
  end Iter;

  package body Iter is
  function First (Vector : Vector_Id) return Cursor is
  begin
     return 0;
  end First;

  function Next (Vector : Vector_Id; Position : Cursor) return Cursor is
  begin
     return Position + 1;
  end Next;

  function Has_Element (Vector : Vector_Id; Position : Cursor) return Boolean
  is
  begin
     return Position < Cursor (Vector);
  end Has_Element;

  function Element (Vector : Vector_Id; Position : Cursor) return Natural is
  begin
     return Natural (Position);
  end Element;
  end Iter;
  use Iter;

  V : Vector_Id;
begin
   V := 5;
   Put_Line ("iteration over cursors");
   for I in V loop
      put_line (integer'image (Integer (I)));
      null;
   end loop;

   Put_Line ("iteration over elements");
   for I of V loop
      put_line (integer'image (Integer (I)));
      null;
   end loop;
end Vect1;

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

2015-11-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Get_Cursor_Type): To determine whether a function
	First is the proper Iterable primitive, use the base type of the
	first formal rather than the type. This is needed in the unusual
	case where the Iterable aspect is specified for an integer type.
diff mbox

Patch

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 230301)
+++ sem_util.adb	(working copy)
@@ -7553,13 +7553,16 @@ 
       Cursor := Any_Type;
 
       --  Locate function with desired name and profile in scope of type
+      --  In the rare case where the type is an integer type, a base type
+      --  is created for it, check that the base type of the first formal
+      --  of First matches the base type of the domain.
 
       Func := First_Entity (Scope (Typ));
       while Present (Func) loop
          if Chars (Func) = Chars (First_Op)
            and then Ekind (Func) = E_Function
            and then Present (First_Formal (Func))
-           and then Etype (First_Formal (Func)) = Typ
+           and then Base_Type (Etype (First_Formal (Func))) = Base_Type (Typ)
            and then No (Next_Formal (First_Formal (Func)))
          then
             if Cursor /= Any_Type then