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 a1146828d6f..20171928a41 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 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 a2944d2cbd0..60bc899d662 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..675f6d5221c 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 rec loop l acc position = + match l with + | [] -> acc + | h::t -> + 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> 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..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 @@ -120,6 +120,29 @@ 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.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() =