fix(js/ts/python): compare ReferenceEquality types by ref

src/Fable.Transforms/Babel/Fable2Babel.fs

@@ -3809,6 +3809,57 @@ but thanks to the optimisation done below we get
         ModuleDecl(entName + Naming.reflectionSuffix, isPublic = ent.IsPublic)
         |> declareModuleMember com ctx fnExpr
 
+    let hasClassMethod name (classMembers: ClassMember array) =
+        classMembers
+        |> Array.exists (
+            function
+            | ClassMethod(ClassFunction(Expression.Identifier(Identifier(key, _)), _), _, _, _, _, _, _, _, _) ->
+                key = name
+            | _ -> false
+        )
+
+    let withReferenceEquality (com: IBabelCompiler) ctx (ent: Fable.Entity) (classMembers: ClassMember array) =
+        let isReferenceEqualityType =
+            (ent.IsFSharpRecord || ent.IsFSharpUnion)
+            && not ent.IsValueType
+            && not (FSharp2Fable.Util.hasStructuralEquality ent)
+
+        if not isReferenceEqualityType then
+            classMembers
+        else
+            let ifTypeScript annotation =
+                if com.IsTypeScript then
+                    Some annotation
+                else
+                    None
+
+            let makeMethod name parameters returnExpr returnType =
+                ClassMember.classMethod (
+                    ClassFunction(Expression.identifier name, false),
+                    parameters,
+                    Some(BlockStatement [| Statement.returnStatement returnExpr |]),
+                    ?returnType = ifTypeScript returnType
+                )
+
+            [|
+                yield! classMembers
+                if not (hasClassMethod "Equals" classMembers) then
+                    let other =
+                        Parameter.parameter ("other", ?typeAnnotation = ifTypeScript AnyTypeAnnotation)
+
+                    makeMethod
+                        "Equals"
+                        [| other |]
+                        (Expression.binaryExpression (BinaryEqual, thisExpr, Expression.identifier other.Name))
+                        BooleanTypeAnnotation
+                if not (hasClassMethod "GetHashCode" classMembers) then
+                    makeMethod
+                        "GetHashCode"
+                        [||]
+                        (libCall com ctx None "Util" "physicalHash" [] [ thisExpr ])
+                        NumberTypeAnnotation
+            |]
+
     let declareType
         (com: IBabelCompiler)
         ctx
@@ -4034,6 +4085,7 @@ but thanks to the optimisation done below we get
         (doc: string option)
         classMembers
         =
+        let classMembers = withReferenceEquality com ctx ent classMembers
         let isPublic = ent.IsPublic
         let tagArgName = "Tag"
         let tagArgTa = makeAliasTypeAnnotation com ctx tagArgName
@@ -4339,6 +4391,7 @@ but thanks to the optimisation done below we get
         (decl: Fable.ClassDecl)
         classMembers
         =
+        let classMembers = withReferenceEquality com ctx ent classMembers
         let fieldIds = getEntityFieldsAsIdents ent |> List.toArray
         let args = fieldIds |> Array.map identAsExpr
 

src/Fable.Transforms/Python/Fable2Python.Transforms.fs

@@ -4297,6 +4297,7 @@ let transformAttachedMethod (com: IPythonCompiler) ctx (info: Fable.MemberFuncti
     ]
 
 let transformUnion (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers =
+    let classMembers = withReferenceEquality com ctx ent classMembers
     // Get generic type parameters for the union
     let typeParams = makeEntityTypeParams com ctx ent
 
@@ -4501,6 +4502,7 @@ let transformClassWithCompilerGeneratedConstructor
     (classAttributes: ClassAttributes)
     =
     // printfn "transformClassWithCompilerGeneratedConstructor"
+    let classMembers = withReferenceEquality com ctx ent classMembers
     let fieldIds = getEntityFieldsAsIdents com ent
 
     let args =

src/Fable.Transforms/Python/Fable2Python.Util.fs

@@ -694,6 +694,46 @@ module Util =
 
     let thisExpr = Expression.name "self"
 
+    let hasClassMethod name (classMembers: Statement list) =
+        classMembers
+        |> List.exists (
+            function
+            | FunctionDef { Name = Identifier key } -> key = name
+            | _ -> false
+        )
+
+    let withReferenceEquality (com: IPythonCompiler) ctx (ent: Fable.Entity) (classMembers: Statement list) =
+        let isReferenceEqualityType =
+            (ent.IsFSharpRecord || ent.IsFSharpUnion)
+            && not ent.IsValueType
+            && not (FSharp2Fable.Util.hasStructuralEquality ent)
+
+        if not isReferenceEqualityType then
+            classMembers
+        else
+            let makeMethod name args returnExpr (returnType: string) =
+                Statement.functionDef (
+                    Identifier name,
+                    Arguments.arguments (args = Arg.arg "self" :: args),
+                    body = [ Statement.return' returnExpr ],
+                    returns = Expression.name returnType
+                )
+
+            [
+                yield! classMembers
+                if not (hasClassMethod "Equals" classMembers) then
+                    let other =
+                        Arg.arg ("other", annotation = com.TransformImport(ctx, "Any", "typing"))
+
+                    makeMethod
+                        "Equals"
+                        [ other ]
+                        (Expression.compare (thisExpr, [ Is ], [ Expression.name "other" ]))
+                        "bool"
+                if not (hasClassMethod "GetHashCode" classMembers) then
+                    makeMethod "GetHashCode" [] (libCall com ctx None "util" "physical_hash" [ thisExpr ]) "int"
+            ]
+
     let ofInt (_com: IPythonCompiler) (_ctx: Context) (i: int) = Expression.intConstant (int i)
 
     let ofString (s: string) = Expression.stringConstant s

tests/Js/Main/ComparisonTests.fs

@@ -39,6 +39,25 @@
 [<ReferenceEquality>]
 type RTest2 = { a2: int; b2: int }
 
+[<ReferenceEquality>]
+type RefEqUnion = RefC of int | RefD of int
+
+[<NoEquality; NoComparison>]
+type NoEqRecord = { a3: int }
+
+[<NoEquality; NoComparison>]
+type NoEqUnion = NoEqCase of int
+
+#nowarn "386"
+[<NoEquality; NoComparison>]
+type NoEqRecordWithOverride =
+    { a4: int }
+    override _.Equals(_) = true
+    override _.GetHashCode() = 4
+
+[<Struct; NoEquality; NoComparison>]
+type NoEqStruct = { s2: int }
+
 type Test(i: int) =
     member x.Value = i
     override x.GetHashCode() = i
@@ -115,6 +134,63 @@
 
 let tests =
   testList "Comparison" [
+    testCase "ReferenceEquality record equality works" <| fun () ->
+        let x = { a2 = 1; b2 = 2 }
+        let y = { a2 = 1; b2 = 2 }
+        equal true (x = x)
+        equal false (x = y)
+        equal true (x <> y)
+        equal false (x.Equals y)
+        equal true (genericEquals x x)
+        equal false (genericEquals x y)
+        equal false ([ x ] = [ y ])
+        equal false ((x, 1) = (y, 1))
+        equal false (Some x = Some y)
+        equal true ([ x ] |> List.contains x)
+        equal false ([ x ] |> List.contains y)
+
+    testCase "ReferenceEquality record hash works" <| fun () ->
+        let x = { a2 = 1; b2 = 2 }
+        let y = { a2 = 1; b2 = 2 }
+        equal (hash x) (hash x)
+        equal (genericHash x) (genericHash x)
+        let d = Dictionary<RTest2, int>()
+        d[x] <- 1
+        equal true (d.ContainsKey x)
+        equal false (d.ContainsKey y)
+        equal 2 (HashSet<RTest2>([ x; y ]).Count)
+
+    testCase "ReferenceEquality union equality works" <| fun () ->
+        let x = RefC 1
+        let y = RefC 1
+        equal true (x = x)
+        equal false (x = y)
+        equal false (x.Equals y)
+        equal true (genericEquals x x)
+        equal false (genericEquals x y)
+        equal false ([ x ] |> List.contains y)
+        equal 2 (HashSet<RefEqUnion>([ x; y ]).Count)
+
+    testCase "NoEquality record and union compare by reference" <| fun () ->
+        let x = { a3 = 1 }
+        equal true ((box x).Equals(box x))
+        equal false ((box x).Equals(box { a3 = 1 }))
+        equal true (genericEquals x x)
+        equal false (genericEquals x { a3 = 1 })
+        let u = NoEqCase 1
+        equal true ((box u).Equals(box u))
+        equal false ((box u).Equals(box (NoEqCase 1)))
+        equal true (genericEquals u u)
+        equal false (genericEquals u (NoEqCase 1))
+
+    testCase "NoEquality record keeps an explicit Equals override" <| fun () ->
+        equal true ((box { a4 = 1 }).Equals(box { a4 = 2 }))
+        equal 4 ((box { a4 = 1 }).GetHashCode())
+
+    testCase "NoEquality struct record compares structurally when boxed" <| fun () ->
+        equal true ((box { s2 = 1 }).Equals(box { s2 = 1 }))
+        equal false ((box { s2 = 1 }).Equals(box { s2 = 2 }))
+
     testCase "Typed array equality works" <| fun () ->
         let xs1 = [| 1; 2; 3 |]
         let xs2 = [| 1; 2; 3 |]
@@ -807,7 +883,7 @@
 
     testCase "EqualityComparer.Create works" <| fun () ->
         let cmp = EqualityComparer<'T>.Create((<>), hash)
         cmp.Equals(1, 1) |> equal false
         cmp.Equals(1, 2) |> equal true
 
     testCase "EqualityComparer.Equals works" <| fun () ->

tests/Js/Main/HashSetTests.fs

@@ -219,15 +219,15 @@ let tests =
         hs.Add(x3) |> equal true
         hs.Count |> equal 2
 
-    // testCase "HashSet.Add with reference records works" <| fun () ->
-    //     let x1 = { a = 5; b = 10 }
-    //     let x2 = { a = 5; b = 10 }
-    //     let x3 = { a = 10; b = 20 }
-    //     let hs = HashSet<RefEqRecord>()
-    //     hs.Add(x1) |> equal true
-    //     hs.Add(x2) |> equal true
-    //     hs.Add(x3) |> equal true
-    //     hs.Count |> equal 3
+    testCase "HashSet.Add with reference records works" <| fun () ->
+        let x1 = { a = 5; b = 10 }
+        let x2 = { a = 5; b = 10 }
+        let x3 = { a = 10; b = 20 }
+        let hs = HashSet<RefEqRecord>()
+        hs.Add(x1) |> equal true
+        hs.Add(x2) |> equal true
+        hs.Add(x3) |> equal true
+        hs.Count |> equal 3
 
     testCase "HashSet.Clear works" <| fun () ->
         let hs = HashSet<_>()

tests/Python/TestComparison.fs

@@ -38,6 +38,34 @@ type UTest2 =
 
 exception Ex of int
 
+[<ReferenceEquality>]
+type RefEqRecord = { a2: int; b2: int }
+
+[<ReferenceEquality>]
+type RefEqUnion = RefC of int | RefD of int
+
+[<NoEquality; NoComparison>]
+type NoEqRecord = { a3: int }
+
+[<NoEquality; NoComparison>]
+type NoEqUnion = NoEqCase of int
+
+#nowarn "386"
+[<NoEquality; NoComparison>]
+type NoEqRecordWithOverride =
+    { a4: int }
+    override _.Equals(other) = true
+    override _.GetHashCode() = 4
+
+[<Struct; NoEquality; NoComparison>]
+type NoEqStruct = { s2: int }
+
+let genericEquals (a: 'T) (b: 'T) : bool =
+    EqualityComparer<'T>.Default.Equals(a, b)
+
+let genericHash (x: 'T) : int =
+    EqualityComparer<'T>.Default.GetHashCode(x)
+
 type MyTest(i: int) =
     member x.Value = i
     override x.GetHashCode() = i
@@ -95,6 +123,69 @@ let ``test PhysicalEquality works`` () = // See #3998
     LanguagePrimitives.PhysicalEquality r2 r2 |> equal true
     LanguagePrimitives.PhysicalEquality r3 r1 |> equal true
 
+[<Fact>]
+let ``test ReferenceEquality record equality works`` () =
+    let x = { a2 = 1; b2 = 2 }
+    let y = { a2 = 1; b2 = 2 }
+    equal true (x = x)
+    equal false (x = y)
+    equal true (x <> y)
+    equal false (x.Equals y)
+    equal true (genericEquals x x)
+    equal false (genericEquals x y)
+    equal false ([ x ] = [ y ])
+    equal false ((x, 1) = (y, 1))
+    equal false (Some x = Some y)
+    equal true ([ x ] |> List.contains x)
+    equal false ([ x ] |> List.contains y)
+
+[<Fact>]
+let ``test ReferenceEquality record hash works`` () =
+    let x = { a2 = 1; b2 = 2 }
+    let y = { a2 = 1; b2 = 2 }
+    equal (hash x) (hash x)
+    equal (genericHash x) (genericHash x)
+    let d = Dictionary<RefEqRecord, int>()
+    d[x] <- 1
+    equal true (d.ContainsKey x)
+    equal false (d.ContainsKey y)
+    equal 2 (HashSet<RefEqRecord>([ x; y ]).Count)
+
+[<Fact>]
+let ``test ReferenceEquality union equality works`` () =
+    let x = RefC 1
+    let y = RefC 1
+    equal true (x = x)
+    equal false (x = y)
+    equal false (x.Equals y)
+    equal true (genericEquals x x)
+    equal false (genericEquals x y)
+    equal false ([ x ] |> List.contains y)
+    equal 2 (HashSet<RefEqUnion>([ x; y ]).Count)
+
+[<Fact>]
+let ``test NoEquality record and union compare by reference`` () =
+    let x = { a3 = 1 }
+    equal true ((box x).Equals(box x))
+    equal false ((box x).Equals(box { a3 = 1 }))
+    equal true (genericEquals x x)
+    equal false (genericEquals x { a3 = 1 })
+    let u = NoEqCase 1
+    equal true ((box u).Equals(box u))
+    equal false ((box u).Equals(box (NoEqCase 1)))
+    equal true (genericEquals u u)
+    equal false (genericEquals u (NoEqCase 1))
+
+[<Fact>]
+let ``test NoEquality record keeps an explicit Equals override`` () =
+    equal true ((box { a4 = 1 }).Equals(box { a4 = 2 }))
+    equal 4 ((box { a4 = 1 }).GetHashCode())
+
+[<Fact>]
+let ``test NoEquality struct record compares structurally when boxed`` () =
+    equal true ((box { s2 = 1 }).Equals(box { s2 = 1 }))
+    equal false ((box { s2 = 1 }).Equals(box { s2 = 2 }))
+
 [<Fact>]
 let ``test Typed array equality works`` () =
     let xs1 = [| 1; 2; 3 |]

tests/Python/TestHashSet.fs

@@ -243,16 +243,16 @@ let ``test HashSet.Add with records works`` () =
     hs.Add(x3) |> equal true
     hs.Count |> equal 2
 
-// [<Fact>]
-// let ``test HashSet.Add with reference records works`` () =
-//     let x1 = { a = 5; b = 10 }
-//     let x2 = { a = 5; b = 10 }
-//     let x3 = { a = 10; b = 20 }
-//     let hs = HashSet<RefEqRecord>()
-//     hs.Add(x1) |> equal true
-//     hs.Add(x2) |> equal true
-//     hs.Add(x3) |> equal true
-//     hs.Count |> equal 3
+[<Fact>]
+let ``test HashSet.Add with reference records works`` () =
+    let x1 = { a = 5; b = 10 }
+    let x2 = { a = 5; b = 10 }
+    let x3 = { a = 10; b = 20 }
+    let hs = HashSet<RefEqRecord>()
+    hs.Add(x1) |> equal true
+    hs.Add(x2) |> equal true
+    hs.Add(x3) |> equal true
+    hs.Count |> equal 3
 
 [<Fact>]
 let ``test HashSet.Clear works`` () =