summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Wai <richard@annexi-strayline.com>2021-03-15 06:24:00 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2021-04-28 05:37:52 -0400
commit5b4b66291f2086f56dc3a1d7df494f901cd0b63e (patch)
tree91443a88a83b517dc2d0d808f76c79033c8b35f8
parentfccc47dddc2ee605dd7fce5c1d1711404e19cd7f (diff)
downloadgcc-5b4b66291f2086f56dc3a1d7df494f901cd0b63e.tar.gz
[Ada] Hashed container Cursor type predefined equality non-conformance
gcc/ada/ * libgnat/a-cohase.ads (Cursor): Synchronize comments for the Cursor type definition to be consistent with identical definitions in other container packages. Add additional comments regarding the importance of maintaining the "Position" component for predefined equality. * libgnat/a-cohama.ads (Cursor): Likewise. * libgnat/a-cihama.ads (Cursor): Likewise. * libgnat/a-cohase.adb (Find, Insert): Ensure that Cursor objects always have their "Position" component set to ensure predefined equality works as required. * libgnat/a-cohama.adb (Find, Insert): Likewise. * libgnat/a-cihama.adb (Find, Insert): Likewise. gcc/testsuite/ * gnat.dg/containers2.adb: New test.
-rw-r--r--gcc/ada/libgnat/a-cihama.adb4
-rw-r--r--gcc/ada/libgnat/a-cihama.ads14
-rw-r--r--gcc/ada/libgnat/a-cohama.adb5
-rw-r--r--gcc/ada/libgnat/a-cohama.ads10
-rw-r--r--gcc/ada/libgnat/a-cohase.adb8
-rw-r--r--gcc/ada/libgnat/a-cohase.ads14
-rw-r--r--gcc/testsuite/gnat.dg/containers2.adb158
7 files changed, 207 insertions, 6 deletions
diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb
index 7a490d545cd..50adea1b46a 100644
--- a/gcc/ada/libgnat/a-cihama.adb
+++ b/gcc/ada/libgnat/a-cihama.adb
@@ -522,7 +522,8 @@ is
return No_Element;
end if;
- return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
+ return Cursor'
+ (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node));
end Find;
--------------------
@@ -748,6 +749,7 @@ is
end if;
Position.Container := Container'Unchecked_Access;
+ Position.Position := HT_Ops.Index (HT, Position.Node);
end Insert;
procedure Insert
diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads
index ccf5f4e58ec..f8961671b37 100644
--- a/gcc/ada/libgnat/a-cihama.ads
+++ b/gcc/ada/libgnat/a-cihama.ads
@@ -363,8 +363,22 @@ private
type Cursor is record
Container : Map_Access;
+ -- Access to this cursor's container
+
Node : Node_Access;
+ -- Access to the node pointed to by this cursor
+
Position : Hash_Type := Hash_Type'Last;
+ -- Position of the node in the buckets of the container. If this is
+ -- equal to Hash_Type'Last, then it will not be used. Position is
+ -- not requried by the implementation, but improves the efficiency
+ -- of various operations.
+ --
+ -- However, this value must be maintained so that the predefined
+ -- equality operation acts as required by RM A.18.4-18/2, which
+ -- states: "The predefined "=" operator for type Cursor returns True
+ -- if both cursors are No_Element, or designate the same element
+ -- in the same container."
end record;
procedure Write
diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb
index 9c4e51a6392..fb46e074261 100644
--- a/gcc/ada/libgnat/a-cohama.adb
+++ b/gcc/ada/libgnat/a-cohama.adb
@@ -478,7 +478,8 @@ is
return No_Element;
end if;
- return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
+ return Cursor'
+ (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node));
end Find;
--------------------
@@ -635,6 +636,7 @@ is
end if;
Position.Container := Container'Unrestricted_Access;
+ Position.Position := HT_Ops.Index (HT, Position.Node);
end Insert;
procedure Insert
@@ -677,6 +679,7 @@ is
end if;
Position.Container := Container'Unrestricted_Access;
+ Position.Position := HT_Ops.Index (HT, Position.Node);
end Insert;
procedure Insert
diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads
index 21b69354db0..c6e377c6bb1 100644
--- a/gcc/ada/libgnat/a-cohama.ads
+++ b/gcc/ada/libgnat/a-cohama.ads
@@ -465,7 +465,15 @@ private
Position : Hash_Type := Hash_Type'Last;
-- Position of the node in the buckets of the container. If this is
- -- equal to Hash_Type'Last, then it will not be used.
+ -- equal to Hash_Type'Last, then it will not be used. Position is
+ -- not requried by the implementation, but improves the efficiency
+ -- of various operations.
+ --
+ -- However, this value must be maintained so that the predefined
+ -- equality operation acts as required by RM A.18.4-18/2, which
+ -- states: "The predefined "=" operator for type Cursor returns True
+ -- if both cursors are No_Element, or designate the same element
+ -- in the same container."
end record;
procedure Read
diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb
index 0131f73eb7a..aac5b1b3cf2 100644
--- a/gcc/ada/libgnat/a-cohase.adb
+++ b/gcc/ada/libgnat/a-cohase.adb
@@ -605,13 +605,13 @@ is
is
HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
Node : constant Node_Access := Element_Keys.Find (HT, Item);
-
begin
if Node = null then
return No_Element;
end if;
- return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last);
+ return Cursor'
+ (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node));
end Find;
--------------------
@@ -763,9 +763,11 @@ is
Position : out Cursor;
Inserted : out Boolean)
is
+ HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
begin
Insert (Container.HT, New_Item, Position.Node, Inserted);
Position.Container := Container'Unchecked_Access;
+ Position.Position := HT_Ops.Index (HT, Position.Node);
end Insert;
procedure Insert
@@ -1998,7 +2000,7 @@ is
return No_Element;
else
return Cursor'
- (Container'Unrestricted_Access, Node, Hash_Type'Last);
+ (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node));
end if;
end Find;
diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads
index a0aca526db9..c1415b57ff8 100644
--- a/gcc/ada/libgnat/a-cohase.ads
+++ b/gcc/ada/libgnat/a-cohase.ads
@@ -537,8 +537,22 @@ private
type Cursor is record
Container : Set_Access;
+ -- Access to this cursor's container
+
Node : Node_Access;
+ -- Access to the node pointed to by this cursor
+
Position : Hash_Type := Hash_Type'Last;
+ -- Position of the node in the buckets of the container. If this is
+ -- equal to Hash_Type'Last, then it will not be used. Position is
+ -- not requried by the implementation, but improves the efficiency
+ -- of various operations.
+ --
+ -- However, this value must be maintained so that the predefined
+ -- equality operation acts as required by RM A.18.7-17/2, which
+ -- states: "The predefined "=" operator for type Cursor returns True
+ -- if both cursors are No_Element, or designate the same element
+ -- in the same container."
end record;
procedure Write
diff --git a/gcc/testsuite/gnat.dg/containers2.adb b/gcc/testsuite/gnat.dg/containers2.adb
new file mode 100644
index 00000000000..9c5dc0f434f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/containers2.adb
@@ -0,0 +1,158 @@
+-- { dg-do run }
+-- { dg-options "-gnata" }
+
+with Ada.Strings.Hash;
+with Ada.Containers.Hashed_Sets;
+with Ada.Containers.Hashed_Maps;
+with Ada.Containers.Indefinite_Hashed_Sets;
+with Ada.Containers.Indefinite_Hashed_Maps;
+
+procedure Containers2 is
+ -- Check that Cursors of the hashed containers follow the correct
+ -- predefined equality rules - that two Cursors to the same element
+ -- are equal, one one is obtained through, for example, iteration,
+ -- and the other is obtained through a search
+
+ subtype Definite_Name is String (1 .. 5);
+
+ type Named_Item is
+ record
+ Name : Definite_Name;
+ Item : Integer := 0;
+ end record;
+
+
+ function Equivalent_Item (Left, Right: Named_Item) return Boolean
+ is (Left.Name = Right.Name);
+
+ function DI_Hash (Item: Named_Item) return Ada.Containers.Hash_Type
+ is (Ada.Strings.Hash (Item.Name));
+
+ package HS is new Ada.Containers.Hashed_Sets
+ (Element_Type => Named_Item,
+ Hash => DI_Hash,
+ Equivalent_Elements => Equivalent_Item);
+
+ package IHS is new Ada.Containers.Indefinite_Hashed_Sets
+ (Element_Type => Named_Item,
+ Hash => DI_Hash,
+ Equivalent_Elements => Equivalent_Item);
+
+ package HM is new Ada.Containers.Hashed_Maps
+ (Key_Type => Definite_Name,
+ Element_Type => Integer,
+ Hash => Ada.Strings.Hash,
+ Equivalent_Keys => "=");
+
+ package IHM is new Ada.Containers.Indefinite_Hashed_Maps
+ (Key_Type => Definite_Name,
+ Element_Type => Integer,
+ Hash => Ada.Strings.Hash,
+ Equivalent_Keys => "=");
+
+ Item_Data : constant array (1 .. 5) of Named_Item
+ := ((Name => "ABCDE", others => <>),
+ (Name => "FGHIJ", others => <>),
+ (Name => "KLMNO", others => <>),
+ (Name => "PQRST", others => <>),
+ (Name => "UVWXY", others => <>));
+
+ use type HS.Cursor;
+ use type IHS.Cursor;
+ use type HM.Cursor;
+ use type IHM.Cursor;
+
+ type HS_Cursor_Vec is array (Item_Data'Range) of HS.Cursor;
+ type IHS_Cursor_Vec is array (Item_Data'Range) of IHS.Cursor;
+ type HM_Cursor_Vec is array (Item_Data'Range) of HM.Cursor;
+ type IHM_Cursor_Vec is array (Item_Data'Range) of IHM.Cursor;
+
+ HSC : HS.Set;
+ IHSC : IHS.Set;
+ HMC : HM.Map;
+ IHMC : IHM.Map;
+
+ HS_Create_Cursors : HS_Cursor_Vec;
+ IHS_Create_Cursors : IHS_Cursor_Vec;
+ HM_Create_Cursors : HM_Cursor_Vec;
+ IHM_Create_Cursors : IHM_Cursor_Vec;
+
+ HS_Index : HS.Cursor;
+ IHS_Index : IHS.Cursor;
+ HM_Index : HM.Cursor;
+ IHM_Index : IHM.Cursor;
+
+ HS_Find : HS.Cursor;
+ IHS_Find : IHS.Cursor;
+ HM_Find : HM.Cursor;
+ IHM_Find : IHM.Cursor;
+
+
+ Inserted : Boolean;
+
+begin
+
+ for I in Item_Data'Range loop
+ HSC.Insert (New_Item => Item_Data(I),
+ Position => HS_Create_Cursors(I),
+ Inserted => Inserted);
+
+ pragma Assert (Inserted);
+
+
+ IHSC.Insert (New_Item => Item_Data(I),
+ Position => IHS_Create_Cursors(I),
+ Inserted => Inserted);
+
+ pragma Assert (Inserted);
+
+ HMC.Insert (New_Item => Item_Data(I).Item,
+ Key => Item_Data(I).Name,
+ Position => HM_Create_Cursors(I),
+ Inserted => Inserted);
+
+ pragma Assert (Inserted);
+
+ IHMC.Insert (New_Item => Item_Data(I).Item,
+ Key => Item_Data(I).Name,
+ Position => IHM_Create_Cursors(I),
+ Inserted => Inserted);
+
+ pragma Assert (Inserted);
+
+ end loop;
+
+ HS_Index := HSC.First;
+ IHS_Index := IHSC.First;
+ HM_Index := HMC.First;
+ IHM_Index := IHMC.First;
+
+ for I in Item_Data'Range loop
+ pragma Assert (HS.Has_Element (HS_Index));
+ pragma Assert (IHS.Has_Element (IHS_Index));
+ pragma Assert (HM.Has_Element (HM_Index));
+ pragma Assert (IHM.Has_Element (IHM_Index));
+
+ HS_Find := HSC.Find (Item_Data(I));
+ pragma Assert (HS_Create_Cursors(I) = HS_Index);
+ pragma Assert (HS_Find = HS_Index);
+
+ IHS_Find := IHSC.Find (Item_Data(I));
+ pragma Assert (IHS_Create_Cursors(I) = IHS_Index);
+ pragma Assert (IHS_Find = IHS_Index);
+
+ HM_Find := HMC.Find (Item_Data(I).Name);
+ pragma Assert (HM_Create_Cursors(I) = HM_Index);
+ pragma Assert (HM_Find = HM_Index);
+
+ IHM_Find := IHMC.Find (Item_Data(I).Name);
+ pragma Assert (IHM_Create_Cursors(I) = IHM_Index);
+ pragma Assert (IHM_Find = IHM_Index);
+
+ HS.Next (HS_Index);
+ IHS.Next (IHS_Index);
+ HM.Next (HM_Index);
+ IHM.Next (IHM_Index);
+ end loop;
+
+end;