From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id D521F398B842; Thu, 8 Jul 2021 13:36:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org D521F398B842 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2145] [Ada] Incorrect iteration over hashed containers after multiple Inserts X-Act-Checkin: gcc X-Git-Author: Ed Schonberg X-Git-Refname: refs/heads/master X-Git-Oldrev: c5b1e8e9a5808d612ad20fdf2f77c52cfa5907d3 X-Git-Newrev: b927d936e339ddd47779b522b80552306ebb5604 Message-Id: <20210708133618.D521F398B842@sourceware.org> Date: Thu, 8 Jul 2021 13:36:18 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 08 Jul 2021 13:36:18 -0000 https://gcc.gnu.org/g:b927d936e339ddd47779b522b80552306ebb5604 commit r12-2145-gb927d936e339ddd47779b522b80552306ebb5604 Author: Ed Schonberg Date: Fri May 21 15:51:13 2021 -0400 [Ada] Incorrect iteration over hashed containers after multiple Inserts gcc/ada/ * libgnat/a-cohama.ads: Introduce an equality operator over cursors. * libgnat/a-cohase.ads: Ditto. * libgnat/a-cohama.adb: Add body for "=" over cursors. (Insert): Do not set the Position component of the cursor that denotes the inserted element. * libgnat/a-cohase.adb: Ditto. Diff: --- gcc/ada/libgnat/a-cohama.adb | 14 ++++++++++++-- gcc/ada/libgnat/a-cohama.ads | 8 ++++++++ gcc/ada/libgnat/a-cohase.adb | 14 ++++++++++++-- gcc/ada/libgnat/a-cohase.ads | 9 +++++++++ 4 files changed, 41 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb index 26bdd552265..e6d6e4d4030 100644 --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -116,6 +116,13 @@ is -- "=" -- --------- + function "=" (Left, Right : Cursor) return Boolean is + begin + return + Left.Container = Right.Container + and then Left.Node = Right.Node; + end "="; + function "=" (Left, Right : Map) return Boolean is begin return Is_Equal (Left.HT, Right.HT); @@ -636,7 +643,11 @@ is end if; Position.Container := Container'Unrestricted_Access; - Position.Position := HT_Ops.Index (HT, Position.Node); + + -- Note that we do not set the Position component of the cursor, + -- because it may become incorrect on subsequent insertions/deletions + -- from the container. This will lose some optimizations but prevents + -- anomalies when the underlying hash-table is expanded or shrunk. end Insert; procedure Insert @@ -679,7 +690,6 @@ 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 a04cb3a34c6..3f172bd399a 100644 --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -110,6 +110,14 @@ is type Cursor is private; pragma Preelaborable_Initialization (Cursor); + function "=" (Left, Right : Cursor) return Boolean; + -- The representation of cursors includes a component used to optimize + -- iteration over maps. This component may become unreliable after + -- multiple map insertions, and must be excluded from cursor equality, + -- so we need to provide an explicit definition for it, instead of + -- using predefined equality (as implied by a questionable comment + -- in the RM). + Empty_Map : constant Map; -- Map objects declared without an initialization expression are -- initialized to the value Empty_Map. diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index 31374f6b9d6..2342116043e 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -145,6 +145,13 @@ is -- "=" -- --------- + function "=" (Left, Right : Cursor) return Boolean is + begin + return + Left.Container = Right.Container + and then Left.Node = Right.Node; + end "="; + function "=" (Left, Right : Set) return Boolean is begin return Is_Equal (Left.HT, Right.HT); @@ -763,11 +770,14 @@ 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); + + -- Note that we do not set the Position component of the cursor, + -- because it may become incorrect on subsequent insertions/deletions + -- from the container. This will lose some optimizations but prevents + -- anomalies when the underlying hash-table is expanded or shrunk. end Insert; procedure Insert diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index f0763afbcfc..2356ba7f66a 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -69,6 +69,15 @@ is type Cursor is private; pragma Preelaborable_Initialization (Cursor); + function "=" (Left, Right : Cursor) return Boolean; + -- The representation of cursors includes a component used to optimize + -- iteration over sets. This component may become unreliable after + -- multiple set insertions, and must be excluded from cursor equality, + -- so we need to provide an explicit definition for it, instead of + -- using predefined equality (as implied by a questionable comment + -- in the RM). This is also the case for hashed maps, and affects the + -- use of Insert primitives in hashed structures. + Empty_Set : constant Set; -- Set objects declared without an initialization expression are -- initialized to the value Empty_Set.