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 <[email protected]>
* 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.
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));
