[release/dev17.4] F# 7 fixes (#14322)

* WIP: Fix for calling init-only setter via srtp call + allow calling special-named functions via srtp
* Fix 14097

Co-authored-by: Vlad Zarytovskii <[email protected]>
Co-authored-by: Tomas Grosup <[email protected]>
Co-authored-by: Don Syme <[email protected]>

Author: 4 people

src/Compiler/Checking/CheckExpressions.fs

@@ -8534,7 +8534,12 @@ and TcTraitItemThen (cenv: cenv) overallTy env objOpt traitInfo tpenv mItem dela
             applicableExpr, exprTy
         | _ ->
             let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip
-            let traitCall = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@ves, mItem)
+            // Account for a unit mismtach in logical v. compiled arguments
+            let compiledArgExprs =
+                match argTys, traitInfo.GetCompiledArgumentTypes() with
+                | [_], [] -> []
+                | _ -> ves
+            let traitCall = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@compiledArgExprs, mItem)
             let v, body = MultiLambdaToTupledLambda g vs traitCall
             let expr = mkLambda mItem v (body, retTy)
             let exprTy = tyOfExpr g expr

src/Compiler/TypedTree/TcGlobals.fs

@@ -1830,12 +1830,12 @@ type TcGlobals(
         let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "atan2", None, Some "Atan2", [vara; varb], ([[varaTy]; [varaTy]], varbTy))
         let tyargs = [aty;bty]
         Some (info, tyargs, argExprs)
-    | "get_Zero", _, Some aty, [_] ->
+    | "get_Zero", _, Some aty, ([] | [_]) ->
         // Call LanguagePrimitives.GenericZero
         let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericZero", None, None, [vara], ([], varaTy))
         let tyargs = [aty]
         Some (info, tyargs, [])
-    | "get_One", _, Some aty, [_] ->
+    | "get_One", _, Some aty,  ([] | [_])  ->
         // Call LanguagePrimitives.GenericOne
         let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericOne", None, None, [vara], ([], varaTy))
         let tyargs = [aty]

tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs

@@ -19,6 +19,38 @@ let setupCompilation compilation =
     |> withReferences [typesModule]
 
 
+[<Fact>]
+let ``Srtp call Zero property returns valid result`` () =
+    Fsx """
+let inline zero<'T when 'T: (static member Zero: 'T)> = 'T.Zero
+let result = zero<int>
+if result <> 0 then failwith $"Something's wrong: {result}"
+    """
+    |> runFsi
+    |> shouldSucceed
+
+[<Fact>]
+let ``Srtp call to custom property returns valid result`` () =
+    FSharp """
+module Foo
+type Foo = 
+    static member Bar = 1
+
+type HasBar<'T when 'T: (static member Bar: int)> = 'T
+
+let inline bar<'T when HasBar<'T>> =
+    'T.Bar
+
+[<EntryPoint>]
+let main _ =
+    let result = bar<Foo>
+    if result <> 0 then
+        failwith $"Unexpected result: {result}"
+    0
+    """
+    |> asExe
+    |> compileAndRun
+
 #if !NETCOREAPP
 [<Theory(Skip = "IWSAMs are not supported by NET472.")>]
 #else
@@ -775,7 +807,11 @@ module ``Active patterns`` =
 
 module ``Suppression of System Numerics interfaces on unitized types`` =
 
-    [<Fact(Skip = "Solution needs to be updated to .NET 7")>]
+#if !NETCOREAPP
+    [<Fact(Skip = "IWSAMs are not supported by NET472.")>]
+#else
+    [<Fact>]
+#endif
     let Baseline () =
         Fsx """
             open System.Numerics
@@ -785,16 +821,19 @@ module ``Suppression of System Numerics interfaces on unitized types`` =
         |> compile
         |> shouldSucceed
 
-    [<Theory(Skip = "Solution needs to be updated to .NET 7")>]
+#if !NETCOREAPP
+    [<Theory(Skip = "IWSAMs are not supported by NET472.")>]
+#else
+    [<Theory>]
     [<InlineData("IAdditionOperators", 3)>]
     [<InlineData("IAdditiveIdentity", 2)>]
     [<InlineData("IBinaryFloatingPointIeee754", 1)>]
     [<InlineData("IBinaryNumber", 1)>]
     [<InlineData("IBitwiseOperators", 3)>]
-    [<InlineData("IComparisonOperators", 2)>]
+    [<InlineData("IComparisonOperators", 3)>]
     [<InlineData("IDecrementOperators", 1)>]
     [<InlineData("IDivisionOperators", 3)>]
-    [<InlineData("IEqualityOperators", 2)>]
+    [<InlineData("IEqualityOperators", 3)>]
     [<InlineData("IExponentialFunctions", 1)>]
     [<InlineData("IFloatingPoint", 1)>]
     [<InlineData("IFloatingPointIeee754", 1)>]
@@ -814,6 +853,7 @@ module ``Suppression of System Numerics interfaces on unitized types`` =
     [<InlineData("ITrigonometricFunctions", 1)>]
     [<InlineData("IUnaryNegationOperators", 2)>]
     [<InlineData("IUnaryPlusOperators", 2)>]
+#endif
     let ``Unitized type shouldn't be compatible with System.Numerics.I*`` name paramCount =
         let typeParams = Seq.replicate paramCount "'T" |> String.concat ","
         let genericType = $"{name}<{typeParams}>"

tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs

@@ -4,19 +4,31 @@ module CheckNewSyntax =
 
     type MyType() = 
         static member val StaticProperty = 0 with get, set
-        static member StaticMethod x = x + 5
+        static member StaticMethod0 () = 5
+        static member StaticMethod1 x = x + 5
+        static member StaticMethod2 (x, y) = x + y + 5
         member val Length = 0 with get, set
         member _.Item with get x = "Hello"
-        member _.InstanceMethod x = x + 5
+        member _.InstanceMethod0 () = 5
+        member _.InstanceMethod1 x = x + 5
+        member _.InstanceMethod2 (x, y) = x + y + 5
 
     // Check that "property" and "get_ method" constraints are considered logically equivalent
     let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty
 
-    let inline f_StaticMethod<'T when 'T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3)
+    let inline f_StaticMethod0<'T when 'T : (static member StaticMethod0: unit -> int) >() : int = 'T.StaticMethod0()
+
+    let inline f_StaticMethod1<'T when 'T : (static member StaticMethod1: int -> int) >() : int = 'T.StaticMethod1(3)
+
+    let inline f_StaticMethod2<'T when 'T : (static member StaticMethod2: int * int -> int) >() : int = 'T.StaticMethod2(3, 3)
 
     let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3)
 
-    let inline f_InstanceMethod<'T when 'T : (member InstanceMethod: int -> int) >(x: 'T) : int = x.InstanceMethod(3)
+    let inline f_InstanceMethod0<'T when 'T : (member InstanceMethod0: unit -> int) >(x: 'T) : int = x.InstanceMethod0()
+
+    let inline f_InstanceMethod1<'T when 'T : (member InstanceMethod1: int -> int) >(x: 'T) : int = x.InstanceMethod1(3)
+
+    let inline f_InstanceMethod2<'T when 'T : (member InstanceMethod2: int * int -> int) >(x: 'T) : int = x.InstanceMethod2(3, 3)
 
     let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length
 
@@ -33,7 +45,13 @@ module CheckNewSyntax =
     //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3
     //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3]
 
-    if f_StaticMethod<MyType>() <> 8 then
+    if f_StaticMethod0<MyType>() <> 5 then
+        failwith "Unexpected result"
+
+    if f_StaticMethod1<MyType>() <> 8 then
+        failwith "Unexpected result"
+
+    if f_StaticMethod2<MyType>() <> 11 then
         failwith "Unexpected result"
 
     if f_set_StaticProperty<MyType>() <> () then
@@ -47,7 +65,13 @@ module CheckNewSyntax =
     if f_Length(myInstance) <> 0 then
         failwith "Unexpected result"
 
-    if f_InstanceMethod(myInstance) <> 8 then
+    if f_InstanceMethod0(myInstance) <> 5 then
+        failwith "Unexpected result"
+
+    if f_InstanceMethod1(myInstance) <> 8 then
+        failwith "Unexpected result"
+
+    if f_InstanceMethod2(myInstance) <> 11 then
         failwith "Unexpected result"
 
     if f_set_Length(myInstance) <> () then

tests/FSharp.Compiler.ComponentTests/Interop/RequiredAndInitOnlyProperties.fs

@@ -8,6 +8,14 @@ open System
 
 module ``Required and init-only properties`` =
 
+    let csharpRecord =
+        CSharp """
+    namespace RequiredAndInitOnlyProperties
+    {
+        public record Recd();
+
+    }""" |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csLib"
+
     let csharpBaseClass = 
         CSharp """
     namespace RequiredAndInitOnlyProperties
@@ -228,7 +236,7 @@ let main _ =
             Error 810, Line 9, Col 5, Line 9, Col 21, "Cannot call 'set_GetInit' - a setter for init-only property, please use object initialization instead. See https://aka.ms/fsharp-assigning-values-to-properties-at-initialization"
         ]
 
- #if !NETCOREAPP
+#if !NETCOREAPP
     [<Fact(Skip = "NET472 is unsupported runtime for this kind of test.")>]
 #else
     [<Fact>]
@@ -259,6 +267,63 @@ let main _ =
             Error 810, Line 9, Col 38, Line 9, Col 40, "Init-only property 'GetInit' cannot be set outside the initialization code. See https://aka.ms/fsharp-assigning-values-to-properties-at-initialization"
         ]
 
+#if !NETCOREAPP
+    [<Fact(Skip = "IWSAMs are not supported by NET472.")>]
+#else
+    [<Fact>]
+#endif
+    let ``F# can change init-only property via SRTP`` () =
+
+        let csharpLib = csharpBaseClass
+
+        let fsharpSource =
+            """
+open System
+open RequiredAndInitOnlyProperties
+
+let inline setGetInit<'T when 'T : (member set_GetInit: int -> unit)> (a: 'T) (x: int) = a.set_GetInit(x)
+
+[<EntryPoint>]
+let main _ =
+    let raio = RAIO()
+    setGetInit raio 111
+    0
+"""
+        FSharp fsharpSource
+        |> asExe
+        |> withLangVersion70
+        |> withReferences [csharpLib]
+        |> compile
+        |> shouldSucceed
+
+ #if !NETCOREAPP
+    [<Fact(Skip = "IWSAMs are not supported by NET472.")>]
+#else
+    [<Fact>]
+#endif
+    let ``F# can call special-named methods via SRTP`` () =
+
+        let csharpLib = csharpRecord
+
+        let fsharpSource =
+            """
+open System
+open RequiredAndInitOnlyProperties
+
+let inline clone<'T when 'T : (member ``<Clone>$``: unit -> 'T)> (a: 'T) = a.``<Clone>$``()
+
+[<EntryPoint>]
+let main _ =
+    let recd = Recd()
+    let _ = clone recd
+    0
+"""
+        FSharp fsharpSource
+        |> asExe
+        |> withLangVersion70
+        |> withReferences [csharpLib]
+        |> compile
+        |> shouldSucceed
 
 #if !NETCOREAPP
     [<Fact(Skip = "NET472 is unsupported runtime for this kind of test.")>]