Patchwork [Ada] Iterations over derived containers

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 29, 2011, 2:07 p.m.
Message ID <20110829140733.GA15514@adacore.com>
Download mbox | patch
Permalink /patch/112060/
State New
Headers show

Comments

Arnaud Charlet - Aug. 29, 2011, 2:07 p.m.
If the domain of iteration is a derived container type, the aspect Default_
Iterator is inherited. As for other calls to inherited operations, the actual
must be view-converted to the type of the formal to be a valid argument.
The following must compile quietly:

    gcc -c -gnat12 repro.adb

---
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
procedure Repro is

   package T_Vectors is new Ada.Containers.Vectors
     (Index_Type => Positive,
      Element_Type => Integer);
   type T_Vector is new T_Vectors.Vector with null record;

   V : T_Vector;

begin

   V.Append (1);
   V.Append (2);

   for C in iterate (V) loop
      Put_Line ("here");
   end loop;

   for E of V loop
      Put_Line ("here");
   end loop;
end Repro;

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

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop): Handle properly a loop over a
	container of a derived type.

Patch

Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb	(revision 178236)
+++ exp_ch5.adb	(working copy)
@@ -2952,9 +2952,12 @@ 
 
             if Of_Present (I_Spec) then
                declare
-                  Default_Iter : constant Entity_Id :=
-                    Find_Aspect (Etype (Container), Aspect_Default_Iterator);
-                  Ent : Entity_Id;
+                  Default_Iter  : constant Entity_Id :=
+                    Entity (
+                      Find_Aspect
+                         (Etype (Container), Aspect_Default_Iterator));
+                  Container_Arg : Node_Id;
+                  Ent           : Entity_Id;
 
                begin
                   Cursor := Make_Temporary (Loc, 'I');
@@ -2963,23 +2966,39 @@ 
                      null;
 
                   else
-                     Iter_Type :=
-                        Etype
-                         (Find_Aspect
-                              (Etype (Container), Aspect_Default_Iterator));
+                     Iter_Type := Etype (Default_Iter);
 
                      --  Rewrite domain of iteration as a call to the default
-                     --  iterator for the container type.
+                     --  iterator for the container type. If the container is
+                     --  a derived type and the aspect is inherited, convert
+                     --  container to parent type. The Cursor type is also
+                     --  inherited from the scope of the parent.
 
+                     if Base_Type (Etype (Container)) =
+                       Base_Type (Etype (First_Formal (Default_Iter)))
+                     then
+                        Container_Arg := New_Copy_Tree (Container);
+
+                     else
+                        Pack := Scope (Default_Iter);
+
+                        Container_Arg :=
+                          Make_Type_Conversion (Loc,
+                            Subtype_Mark =>
+                              New_Occurrence_Of (
+                                Etype (First_Formal (Default_Iter)), Loc),
+                            Expression => New_Copy_Tree (Container));
+                     end if;
+
                      Rewrite (Name (I_Spec),
                        Make_Function_Call (Loc,
-                         Name => Default_Iter,
+                         Name => New_Occurrence_Of (Default_Iter, Loc),
                          Parameter_Associations =>
-                           New_List (Relocate_Node (Name (I_Spec)))));
+                           New_List (Container_Arg)));
                      Analyze_And_Resolve (Name (I_Spec));
                   end if;
 
-                  --  Find cursor type in container package.
+                  --  Find cursor type in proper container package.
 
                   Ent := First_Entity (Pack);
                   while Present (Ent) loop