Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 10 additions & 1 deletion src/Compiler/Checking/AugmentWithHashCompare.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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<T> 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
Expand Down
9 changes: 5 additions & 4 deletions src/Compiler/TypedTree/TypedTreeOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
| _ ->
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/Compiler/TypedTree/TypedTreeOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 10 additions & 0 deletions src/FSharp.Core/prim-types.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -120,6 +120,29 @@ type ListType() =
Assert.AreEqual("[1; 2; 3]", [1; 2; 3].ToString())
Assert.AreEqual("[]", [].ToString())
Assert.AreEqual("[]", ([] : decimal list list).ToString())

[<Fact>]
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)

[<Fact>]
member this.HashCodeDoesNotThrowOnListOfNullStrings() =
let l = ["1";"2";null;null]
Assert.AreEqual(l.GetHashCode(),l.GetHashCode())

[<Fact>]
member this.HashCodeIsDifferentForListsWithSamePrefix() =
let sharedPrefix = [0..500]
let l1 = sharedPrefix @ [1]
let l2 = sharedPrefix @ [2]

Assert.AreNotEqual(l1.GetHashCode(),l2.GetHashCode())

[<Fact>]
member this.ObjectEquals() =
Expand Down