From 5c33c31010d9ba8398e4f1487b9cbc1982008d84 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 28 Dec 2022 17:14:42 +0100 Subject: [PATCH 1/4] Prevent Stackoverflow when hashing lists above ~30k elements --- src/Compiler/Checking/AugmentWithHashCompare.fs | 11 ++++++++++- src/Compiler/TypedTree/TypedTreeOps.fs | 9 +++++---- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 ++ src/FSharp.Core/prim-types.fs | 10 ++++++++++ .../Microsoft.FSharp.Collections/ListType.fs | 10 ++++++++++ 5 files changed, 37 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index dd81dc0a575..ad2645e1940 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -996,7 +996,16 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon // build the hash rhs let withcGetHashCodeExpr = let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty - let thisv, hashe = hashf g tcref tycon compe + + // Special case List type to avoid StackOverflow exception , call custom hash code instead + let thisv,hashe = + if tyconRefEq g tcref g.list_tcr_canon && tycon.HasMember g "CustomHashCode" [g.IEqualityComparer_ty] then + let customCodeVal = (tycon.TryGetMember g "CustomHashCode" [g.IEqualityComparer_ty]).Value + let tinst, ty = mkMinimalTy g tcref + let thisv, thise = mkThisVar g m ty + thisv,mkApps g ((exprForValRef m customCodeVal, customCodeVal.Type), (if isNil tinst then [] else [tinst]), [thise; compe], m) + else + hashf g tcref tycon compe mkLambdas g m tps [thisv; compv] (hashe, g.int_ty) // build the equals rhs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 1ff908d445a..be16d97ba73 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9573,11 +9573,11 @@ type Entity with List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfos) argTys && membInfo.MemberFlags.IsOverrideOrExplicitImpl | _ -> false) - - member tycon.HasMember g nm argTys = + + member internal tycon.TryGetMember g nm argTys = tycon.TypeContents.tcaug_adhoc |> NameMultiMap.find nm - |> List.exists (fun vref -> + |> List.tryFind (fun vref -> match vref.MemberInfo with | None -> false | _ -> @@ -9586,7 +9586,8 @@ type Entity with match argInfos with | [argInfos] -> List.lengthsEqAndForall2 (typeEquiv g) (List.map fst argInfos) argTys | _ -> false) - + + member tycon.HasMember g nm argTys = (tycon.TryGetMember g nm argTys).IsSome type EntityRef with member tcref.HasInterface g ty = tcref.Deref.HasInterface g ty diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index ae58019683a..de279f174c0 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2449,6 +2449,8 @@ type Entity with member HasMember: TcGlobals -> string -> TType list -> bool + member internal TryGetMember: TcGlobals -> string -> TType list -> ValRef option + type EntityRef with member HasInterface: TcGlobals -> TType -> bool diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 604abae7688..95fe94329a9 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -3912,6 +3912,16 @@ namespace Microsoft.FSharp.Collections type List<'T> = | ([]) : 'T list | ( :: ) : Head: 'T * Tail: 'T list -> 'T list + member private this.CustomHashCode(c:IEqualityComparer) = + let upperBoundAllowedIterations = LanguagePrimitives.HashCompare.defaultHashNodes + let rec loop l acc remainingIterations = + match l with + | [] -> acc + | _ when remainingIterations < 1 -> acc + | h::t -> + loop t (LanguagePrimitives.HashCompare.HashCombine remainingIterations acc (c.GetHashCode(h))) (remainingIterations-1) + + loop this 0 upperBoundAllowedIterations interface IEnumerable<'T> interface IEnumerable interface IReadOnlyCollection<'T> diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs index fd78d5298f5..c510d4dd03a 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs @@ -120,6 +120,16 @@ type ListType() = Assert.AreEqual("[1; 2; 3]", [1; 2; 3].ToString()) Assert.AreEqual("[]", [].ToString()) Assert.AreEqual("[]", ([] : decimal list list).ToString()) + + [] + member this.HashCodeNotThrowingStackOverflow() = + let l = 1 :: 2 :: [0.. 35_000] + let hash = l.GetHashCode() + + let l2 = [1;2] @ [0.. 35_000] + let hash2 = l.GetHashCode() + + Assert.AreEqual(hash,hash2) [] member this.ObjectEquals() = From d796a1ce9b6ccdc5d91b1594bd701ccbebb7834d Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Jan 2023 12:58:25 +0100 Subject: [PATCH 2/4] Remove artificial limit for hashing --- src/FSharp.Core/prim-types.fs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 95fe94329a9..c2a37f9d368 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -3912,16 +3912,14 @@ namespace Microsoft.FSharp.Collections type List<'T> = | ([]) : 'T list | ( :: ) : Head: 'T * Tail: 'T list -> 'T list - member private this.CustomHashCode(c:IEqualityComparer) = - let upperBoundAllowedIterations = LanguagePrimitives.HashCompare.defaultHashNodes - let rec loop l acc remainingIterations = + member private this.CustomHashCode(c:IEqualityComparer) = + let rec loop l acc position = match l with - | [] -> acc - | _ when remainingIterations < 1 -> acc + | [] -> acc | h::t -> - loop t (LanguagePrimitives.HashCompare.HashCombine remainingIterations acc (c.GetHashCode(h))) (remainingIterations-1) + loop t (LanguagePrimitives.HashCompare.HashCombine position acc (c.GetHashCode(h))) (position+1) - loop this 0 upperBoundAllowedIterations + loop this 0 0 interface IEnumerable<'T> interface IEnumerable interface IReadOnlyCollection<'T> From 4295f23274bd84d661b94f5e9cc1a4435097ab77 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Jan 2023 14:20:53 +0100 Subject: [PATCH 3/4] Update src/Compiler/TypedTree/TypedTreeOps.fs --- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index be16d97ba73..2c088b4a507 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9574,7 +9574,7 @@ type Entity with membInfo.MemberFlags.IsOverrideOrExplicitImpl | _ -> false) - member internal tycon.TryGetMember g nm argTys = + member tycon.TryGetMember g nm argTys = tycon.TypeContents.tcaug_adhoc |> NameMultiMap.find nm |> List.tryFind (fun vref -> From 8ff806d92e960db0e17277298eb33193523e48ab Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Jan 2023 14:58:25 +0100 Subject: [PATCH 4/4] Replacing comparer.GetHashCode with GenericHashWithComparer for better inlining --- src/FSharp.Core/prim-types.fs | 4 +++- .../Microsoft.FSharp.Collections/ListType.fs | 13 +++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index c2a37f9d368..675f6d5221c 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -3917,7 +3917,9 @@ namespace Microsoft.FSharp.Collections match l with | [] -> acc | h::t -> - loop t (LanguagePrimitives.HashCompare.HashCombine position acc (c.GetHashCode(h))) (position+1) + let hashOfH = GenericHashWithComparer c h + let acc = LanguagePrimitives.HashCompare.HashCombine position acc hashOfH + loop t acc (position+1) loop this 0 0 interface IEnumerable<'T> diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs index c510d4dd03a..653f9b3a40b 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Collections/ListType.fs @@ -130,6 +130,19 @@ type ListType() = let hash2 = l.GetHashCode() Assert.AreEqual(hash,hash2) + + [] + member this.HashCodeDoesNotThrowOnListOfNullStrings() = + let l = ["1";"2";null;null] + Assert.AreEqual(l.GetHashCode(),l.GetHashCode()) + + [] + member this.HashCodeIsDifferentForListsWithSamePrefix() = + let sharedPrefix = [0..500] + let l1 = sharedPrefix @ [1] + let l2 = sharedPrefix @ [2] + + Assert.AreNotEqual(l1.GetHashCode(),l2.GetHashCode()) [] member this.ObjectEquals() =