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
7 changes: 6 additions & 1 deletion src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/TypedTree/TcGlobals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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)>]
Expand All @@ -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}>"
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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>]
Expand Down Expand Up @@ -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.")>]
Expand Down