[Ada] Iterable aspect of derived types

[Pierre-Marie de Rodat]

This patch avoids incorrect compilation errors if a derived type has a
parent type for which the Iterable aspect is specified, and a "for
... of" loop is used on an object of the derived type.

The following test should compile quietly.

gcc -c seqs-main.adb

package Seqs is
   type Container is null record
     with Iterable =>
       (First => First_Element,
        Next => Next,
        Has_Element => Has_Element,
        Element => Get_Element);

   type Cursor is new Integer;
   type Element is new Boolean;
   type Element_Access is access all Element;

   function First_Element (Self : Container) return Cursor;
   function Next (Self : Container; C : Cursor) return Cursor;
   function Has_Element (Self : Container; C : Cursor) return Boolean;
   function Get_Element (Self : Container; C : Cursor) return Element_Access;

   type Derived is new Container;
end Seqs;

procedure Seqs.Main is
   S : Derived;
begin
   for X of S loop
      null;
   end loop;
end Seqs.Main;

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

2017-09-18  Bob Duff  <d...@adacore.com>

        * exp_ch5.adb (Build_Formal_Container_Iteration,
        Expand_Formal_Container_Element_Loop): Convert the container to the
        root type before passing it to the iteration operations, so it will be
        of the right type.


Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 252907)
+++ exp_ch5.adb (working copy)
@@ -74,6 +74,12 @@
    --  Utility to create declarations and loop statement for both forms
    --  of formal container iterators.
 
+   function Convert_To_Iterable_Type
+     (Container : Entity_Id; Loc : Source_Ptr) return Node_Id;
+   --  Returns New_Occurrence_Of (Container), possibly converted to an
+   --  ancestor type, if the type of Container inherited the Iterable
+   --  aspect_specification from that ancestor.
+
    function Change_Of_Representation (N : Node_Id) return Boolean;
    --  Determine if the right-hand side of assignment N is a type conversion
    --  which requires a change of representation. Called only for the array
@@ -189,7 +195,7 @@
             Make_Function_Call (Loc,
               Name                   => New_Occurrence_Of (First_Op, Loc),
               Parameter_Associations => New_List (
-                New_Occurrence_Of (Container, Loc))));
+                Convert_To_Iterable_Type (Container, Loc))));
 
       --  Statement that advances cursor in loop
 
@@ -200,7 +206,7 @@
             Make_Function_Call (Loc,
               Name                   => New_Occurrence_Of (Next_Op, Loc),
               Parameter_Associations => New_List (
-                New_Occurrence_Of (Container, Loc),
+                Convert_To_Iterable_Type (Container, Loc),
                 New_Occurrence_Of (Cursor, Loc))));
 
       --  Iterator is rewritten as a while_loop
@@ -211,13 +217,12 @@
             Make_Iteration_Scheme (Loc,
               Condition =>
                 Make_Function_Call (Loc,
-                  Name                   =>
-                    New_Occurrence_Of (Has_Element_Op, Loc),
+                  Name => New_Occurrence_Of (Has_Element_Op, Loc),
                   Parameter_Associations => New_List (
-                    New_Occurrence_Of (Container, Loc),
+                    Convert_To_Iterable_Type (Container, Loc),
                     New_Occurrence_Of (Cursor, Loc)))),
-          Statements       => Stats,
-          End_Label        => Empty);
+          Statements => Stats,
+          End_Label  => Empty);
    end Build_Formal_Container_Iteration;
 
    ------------------------------
@@ -233,6 +238,26 @@
             not Same_Representation (Etype (Rhs), Etype (Expression (Rhs)));
    end Change_Of_Representation;
 
+   ------------------------------
+   -- Convert_To_Iterable_Type --
+   ------------------------------
+
+   function Convert_To_Iterable_Type
+     (Container : Entity_Id; Loc : Source_Ptr) return Node_Id
+   is
+      Typ    : constant Entity_Id  := Base_Type (Etype (Container));
+      Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
+      Result : Node_Id := New_Occurrence_Of (Container, Loc);
+   begin
+      if Entity (Aspect) /= Typ then
+         Result := Make_Type_Conversion (Loc,
+                     Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
+                     Expression   => Result);
+      end if;
+
+      return Result;
+   end Convert_To_Iterable_Type;
+
    -------------------------
    -- Expand_Assign_Array --
    -------------------------
@@ -3207,7 +3232,7 @@
            Make_Function_Call (Loc,
              Name                   => New_Occurrence_Of (Element_Op, Loc),
              Parameter_Associations => New_List (
-               New_Occurrence_Of (Container, Loc),
+               Convert_To_Iterable_Type (Container, Loc),
                New_Occurrence_Of (Cursor, Loc))));
 
          Set_Statements (New_Loop,
@@ -3226,7 +3251,7 @@
                Make_Function_Call (Loc,
                  Name                   => New_Occurrence_Of (Element_Op, Loc),
                  Parameter_Associations => New_List (
-                   New_Occurrence_Of (Container, Loc),
+                   Convert_To_Iterable_Type (Container, Loc),
                    New_Occurrence_Of (Cursor, Loc))));
 
          Prepend (Elmt_Ref, Stats);