Skip to content

Commit

Permalink
[release/dev17.4] F# 7 fixes (#14322)
Browse files Browse the repository at this point in the history
* WIP: Fix for calling init-only setter via srtp call + allow calling special-named functions via srtp
* Fix 14097

Co-authored-by: Vlad Zarytovskii <vzaritovsky@hotmail.com>
Co-authored-by: Tomas Grosup <tomasgrosup@microsoft.com>
Co-authored-by: Don Syme <dsyme@users.noreply.github.com>
4 people authored Nov 21, 2022
1 parent f90ab57 commit 1d892dd
Showing 5 changed files with 148 additions and 14 deletions.
7 changes: 6 additions & 1 deletion src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
@@ -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
4 changes: 2 additions & 2 deletions src/Compiler/TypedTree/TcGlobals.fs
Original file line number Diff line number Diff line change
@@ -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]
Original file line number Diff line number Diff line change
@@ -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}>"
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -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.")>]

0 comments on commit 1d892dd

Please sign in to comment.