gcc/testsuite/gnat.dg/containers2.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnata" }
   3
   4 with Ada.Strings.Hash;
   5 with Ada.Containers.Hashed_Sets;
   6 with Ada.Containers.Hashed_Maps;
   7 with Ada.Containers.Indefinite_Hashed_Sets;
   8 with Ada.Containers.Indefinite_Hashed_Maps;
   9
  10 procedure Containers2 is
  11    --  Check that Cursors of the hashed containers follow the correct
  12    --  predefined equality rules - that two Cursors to the same element
  13    --  are equal, one one is obtained through, for example, iteration,
  14    --  and the other is obtained through a search
  15
  16    subtype Definite_Name is String (1 .. 5);
  17
  18    type Named_Item is
  19       record
  20          Name : Definite_Name;
  21          Item : Integer := 0;
  22       end record;
  23
  24
  25    function Equivalent_Item (Left, Right: Named_Item) return Boolean
  26    is (Left.Name = Right.Name);
  27
  28    function DI_Hash (Item: Named_Item) return Ada.Containers.Hash_Type
  29    is (Ada.Strings.Hash (Item.Name));
  30
  31    package HS is new Ada.Containers.Hashed_Sets
  32      (Element_Type        => Named_Item,
  33       Hash                => DI_Hash,
  34       Equivalent_Elements => Equivalent_Item);
  35
  36    package IHS is new Ada.Containers.Indefinite_Hashed_Sets
  37      (Element_Type        => Named_Item,
  38       Hash                => DI_Hash,
  39       Equivalent_Elements => Equivalent_Item);
  40
  41    package HM is new Ada.Containers.Hashed_Maps
  42      (Key_Type        => Definite_Name,
  43       Element_Type    => Integer,
  44       Hash            => Ada.Strings.Hash,
  45       Equivalent_Keys => "=");
  46
  47    package IHM is new Ada.Containers.Indefinite_Hashed_Maps
  48      (Key_Type        => Definite_Name,
  49       Element_Type    => Integer,
  50       Hash            => Ada.Strings.Hash,
  51       Equivalent_Keys => "=");
  52
  53    Item_Data : constant array (1 .. 5) of Named_Item
  54      := ((Name => "ABCDE", others => <>),
  55          (Name => "FGHIJ", others => <>),
  56          (Name => "KLMNO", others => <>),
  57          (Name => "PQRST", others => <>),
  58          (Name => "UVWXY", others => <>));
  59
  60    use type HS.Cursor;
  61    use type IHS.Cursor;
  62    use type HM.Cursor;
  63    use type IHM.Cursor;
  64
  65    type HS_Cursor_Vec  is array (Item_Data'Range) of HS.Cursor;
  66    type IHS_Cursor_Vec is array (Item_Data'Range) of IHS.Cursor;
  67    type HM_Cursor_Vec  is array (Item_Data'Range) of HM.Cursor;
  68    type IHM_Cursor_Vec is array (Item_Data'Range) of IHM.Cursor;
  69
  70    HSC  : HS.Set;
  71    IHSC : IHS.Set;
  72    HMC  : HM.Map;
  73    IHMC : IHM.Map;
  74
  75    HS_Create_Cursors  : HS_Cursor_Vec;
  76    IHS_Create_Cursors : IHS_Cursor_Vec;
  77    HM_Create_Cursors  : HM_Cursor_Vec;
  78    IHM_Create_Cursors : IHM_Cursor_Vec;
  79
  80    HS_Index  : HS.Cursor;
  81    IHS_Index : IHS.Cursor;
  82    HM_Index  : HM.Cursor;
  83    IHM_Index : IHM.Cursor;
  84
  85    HS_Find  : HS.Cursor;
  86    IHS_Find : IHS.Cursor;
  87    HM_Find  : HM.Cursor;
  88    IHM_Find : IHM.Cursor;
  89
  90
  91    Inserted : Boolean;
  92
  93 begin
  94
  95    for I in Item_Data'Range loop
  96       HSC.Insert (New_Item => Item_Data(I),
  97                   Position => HS_Create_Cursors(I),
  98                   Inserted => Inserted);
  99
 100       pragma Assert (Inserted);
 101
 102
 103       IHSC.Insert (New_Item => Item_Data(I),
 104                    Position => IHS_Create_Cursors(I),
 105                    Inserted => Inserted);
 106
 107       pragma Assert (Inserted);
 108
 109       HMC.Insert (New_Item => Item_Data(I).Item,
 110                   Key      => Item_Data(I).Name,
 111                   Position => HM_Create_Cursors(I),
 112                   Inserted => Inserted);
 113
 114       pragma Assert (Inserted);
 115
 116       IHMC.Insert (New_Item => Item_Data(I).Item,
 117                    Key      => Item_Data(I).Name,
 118                    Position => IHM_Create_Cursors(I),
 119                    Inserted => Inserted);
 120
 121       pragma Assert (Inserted);
 122
 123    end loop;
 124
 125    HS_Index  := HSC.First;
 126    IHS_Index := IHSC.First;
 127    HM_Index  := HMC.First;
 128    IHM_Index := IHMC.First;
 129
 130    for I in Item_Data'Range loop
 131       pragma Assert (HS.Has_Element  (HS_Index));
 132       pragma Assert (IHS.Has_Element (IHS_Index));
 133       pragma Assert (HM.Has_Element  (HM_Index));
 134       pragma Assert (IHM.Has_Element (IHM_Index));
 135
 136       HS_Find := HSC.Find (Item_Data(I));
 137       pragma Assert (HS_Create_Cursors(I) = HS_Index);
 138       pragma Assert (HS_Find = HS_Index);
 139
 140       IHS_Find := IHSC.Find (Item_Data(I));
 141       pragma Assert (IHS_Create_Cursors(I) = IHS_Index);
 142       pragma Assert (IHS_Find = IHS_Index);
 143
 144       HM_Find := HMC.Find (Item_Data(I).Name);
 145       pragma Assert (HM_Create_Cursors(I) = HM_Index);
 146       pragma Assert (HM_Find = HM_Index);
 147
 148       IHM_Find := IHMC.Find (Item_Data(I).Name);
 149       pragma Assert (IHM_Create_Cursors(I) = IHM_Index);
 150       pragma Assert (IHM_Find = IHM_Index);
 151
 152       HS.Next  (HS_Index);
 153       IHS.Next (IHS_Index);
 154       HM.Next  (HM_Index);
 155       IHM.Next (IHM_Index);
 156    end loop;
 157
 158 end;