diff mbox

[Ada] Container Indexing over a derived container type

Message ID 20140718092706.GA7161@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 18, 2014, 9:27 a.m. UTC
the container type is a derived type, the value of the inherited  aspect is the
Reference (or Constant_Reference) operation declared for the parent type.
However, Reference is also a primitive operation of the new type, and the
inherited operation has a different signature. It is necessary to retrieve the
right operation from the list of primitive operations of the derived type.

Compiling and executing the following must yield:

 2
 10
 111
 1

---
with Ada.Characters.Handling;
use Ada.Characters.Handling;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
use Ada.Containers;
with Text_IO; use Text_IO;

procedure Derived_Container is

   function Same_Strings (S, T : String) return Boolean is
   begin
      return To_Lower (S) = To_Lower (T);
   end Same_Strings;

   type Place is record
     Page : Positive;
     Line : Positive;
     Col  : Positive;
   end record;

   package Places is new Doubly_Linked_Lists (Place);

   package Indexes is new Indefinite_Hashed_Maps
     (Key_Type        => String,
      Element_Type    => Places.List,
      Hash            => Ada.Strings.Hash,
      Equivalent_Keys => Same_Strings,
      "="             => Places."=");

   type Text_Map is new Indexes.Map with null record;
   --   with   Variable_Indexing => Reference;
   -- Without aspect, indexing  gives
   --       "container cannot be indexed with "Cursor""

   My_Index : Text_Map;

   My_Place : constant Place := (1, 2, 3);
   
   use type Indexes.Cursor;

   procedure Add_Entry
     (The_Index : in out Text_Map;
      Word      : String;
      P         : Place) is

      M_Cursor : Indexes.Cursor;
      New_List : Places.List := Places.Empty_List;

   begin

      M_Cursor := The_Index.Find (Word);
      if M_Cursor /= Indexes.No_Element then
         The_Index (M_Cursor).Append (P);
      else
         New_List.Append (P);
         The_Index.Include (Word, New_List);
      end if;

   end Add_Entry;

begin

   Add_Entry
     (The_Index => My_Index,
      Word      => "bill",
      P         => My_Place);

   Add_Entry
     (The_Index => My_Index,
      Word      => "John",
      P         => (10, 10, 10));

   Add_Entry
     (The_Index => My_Index,
      Word      => "John",
      P         => (111, 333, 999));
   Put_Line (Integer'Image (Integer (My_Index.Length)));
   for Datum of My_Index loop
      for Location of Datum loop
         Put_Line (Integer'Image (Location.Page));
      end loop;
   end loop;
end Derived_Container;

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

2014-07-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing):  If the container
	type is a derived type, the value of the inherited  aspect is
	the Reference operation declared for the parent type. However,
	Reference is also a primitive operation of the new type, and
	the inherited operation has a different signature. We retrieve
	the right one from the list of primitive operations of the
	derived type.
diff mbox

Patch

Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 212779)
+++ sem_ch4.adb	(working copy)
@@ -7020,6 +7020,16 @@ 
          else
             return False;
          end if;
+
+      --  If the container type is a derived type, the value of the inherited
+      --  aspect is the Reference operation declared for the parent type.
+      --  However, Reference is also a primitive operation of the type, and
+      --  the inherited operation has a different signature. We retrieve the
+      --  right one from the list of primitive operations of the derived type.
+
+      elsif Is_Derived_Type (Etype (Prefix)) then
+         Func := Find_Prim_Op (Etype (Prefix), Chars (Func_Name));
+         Func_Name := New_Occurrence_Of (Func, Loc);
       end if;
 
       Assoc := New_List (Relocate_Node (Prefix));