From 0ae8c8305e729752d57c194d534f0f62d31ca07e Mon Sep 17 00:00:00 2001 From: Nino Floris Date: Mon, 22 Aug 2022 15:27:42 +0200 Subject: [PATCH] Fix issues around type directed conversion (#13673) --- src/Compiler/Checking/CheckExpressions.fs | 14 +- src/Compiler/Checking/ConstraintSolver.fs | 32 +- src/Compiler/Checking/MethodCalls.fs | 89 ++-- src/Compiler/Checking/MethodCalls.fsi | 2 +- .../Compiler/Language/OptionalInteropTests.fs | 14 +- .../Language/TypeDirectedConversionTests.fs | 442 ++++++++++++++++++ tests/fsharp/FSharpSuite.Tests.fsproj | 1 + 7 files changed, 519 insertions(+), 75 deletions(-) create mode 100644 tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index fbb57c91dcc..2261a77d407 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -453,7 +453,7 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy = | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes warn -> warning(warn env.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _) -> warning(warn env.DisplayEnv) | TypeDirectedConversionUsed.No -> () if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then @@ -5385,7 +5385,7 @@ and TcAdjustExprForTypeDirectedConversions (cenv: cenv) (overallTy: OverallTy) a let g = cenv.g match overallTy with - | MustConvertTo (_, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions -> + | MustConvertTo (isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions || (g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg) -> let tcVal = LightweightTcValForUsingInBuildMethodCall g AdjustExprForTypeDirectedConversions tcVal g cenv.amap cenv.infoReader env.AccessRights reqdTy actualTy m expr | _ -> @@ -9704,12 +9704,9 @@ and TcMethodApplication let expr = mkLetsBind mMethExpr outArgTmpBinds expr expr, tyOfExpr g expr - // Subsumption or conversion to return type - let callExpr2b = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2 - // Handle post-hoc property assignments - let setterExprPrebinders, callExpr3 = - let expr = callExpr2b + let setterExprPrebinders, callExpr2b = + let expr = callExpr2 CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr @@ -9731,6 +9728,9 @@ and TcMethodApplication let expr = mkCompGenLet mMethExpr objv expr (mkCompGenSequential mMethExpr propSetExpr objExpr) setterExprPrebinders, expr + // Subsumption or conversion to return type + let callExpr3 = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2b + // Build the lambda expression if any, if the method is used as a first-class value let callExpr4 = let expr = callExpr3 diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 77b3cb3486a..8feeb65a6a1 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2695,21 +2695,21 @@ and AddWrappedContextualSubsumptionReport (csenv: ConstraintSolverEnv) ndeep m c | _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m))) /// Assert a subtype constraint -and SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 wrapper = +and SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln origTy1 ty1 ty2 wrapper = // Due to the legacy of the change https://github.com/dotnet/fsharp/pull/1650, // when doing nested, speculative overload resolution, we ignore failed member constraints and continue. The // constraint is not recorded for later solution. if csenv.IsSpeculativeForMethodOverloading then IgnoreFailedMemberConstraintResolution (fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) - (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper) + (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln (defaultArg origTy1 ty1) ty2 res wrapper) else PostponeOnFailedMemberConstraintResolution csenv trace (fun csenv -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) - (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper) + (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln (defaultArg origTy1 ty1) ty2 res wrapper) -and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 = - SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln ty1 ty2 id +and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln origTy1 ty1 ty2 = + SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln origTy1 ty1 ty2 id and SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actualTy expectedTy = TryD @@ -2738,9 +2738,9 @@ and ArgsMustSubsumeOrConvert msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () - do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArg.CallerArgumentType + do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArg.CallerArgumentType if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then return! ErrorD(Error(FSComp.SR.csMethodExpectsParams(), m)) else @@ -2769,9 +2769,9 @@ and ArgsMustSubsumeOrConvertWithContextualReport msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () - do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg)) + do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg)) return usesTDC } @@ -2783,7 +2783,7 @@ and TypesEquiv csenv ndeep trace cxsln ty1 ty2 = and TypesMustSubsume (csenv: ConstraintSolverEnv) ndeep trace cxsln m calledArgTy callerArgTy = trackErrors { - do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArgTy + do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None calledArgTy callerArgTy return TypeDirectedConversionUsed.No } @@ -2796,9 +2796,9 @@ and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () - do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln reqdTy actualTy + do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None reqdTy actualTy return usesTDC } @@ -2813,7 +2813,7 @@ and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConst msg csenv.DisplayEnv | None -> () match usesTDC with - | TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv) + | TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv) | TypeDirectedConversionUsed.No -> () if not (typeEquiv csenv.g calledArgTy callerArgTy) then return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m)) @@ -3223,6 +3223,10 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG // Prefer methods that don't use type-directed conversion let c = compare (match usesTDC1 with TypeDirectedConversionUsed.No -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.No -> 1 | _ -> 0) if c <> 0 then c else + + // Prefer methods that need less type-directed conversion + let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) + if c <> 0 then c else // Prefer methods that don't give "this code is less generic" warnings // Note: Relies on 'compare' respecting true > false @@ -3519,7 +3523,7 @@ let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m extraRigidTypars let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = let csenv = MakeConstraintSolverEnv contextInfo css m denv - SolveTypeSubsumesTypeWithReport csenv 0 m trace None ty1 ty2 + SolveTypeSubsumesTypeWithReport csenv 0 m trace None None ty1 ty2 |> RaiseOperationResult let AddCxMethodConstraint denv css m trace traitInfo = diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 76d0560349d..c524b1bd03f 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -236,12 +236,15 @@ type TypeDirectedConversion = [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool | No static member Combine a b = - match a with - | Yes _ -> a - | No -> b + match a, b with + | Yes(_,true), _ -> a + | _, Yes(_,true) -> b + | Yes _, _ -> a + | _, Yes _ -> b + | No, No -> a let MapCombineTDCD mapper xs = MapReduceD mapper TypeDirectedConversionUsed.No TypeDirectedConversionUsed.Combine xs @@ -279,21 +282,33 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // Adhoc int32 --> int64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None // Adhoc int32 --> nativeint elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None // Adhoc int32 --> float64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg && isNullableTy g reqdTy && not (isNullableTy g actualTy) then + let underlyingTy = destNullableTy g reqdTy + // shortcut + if typeEquiv g underlyingTy actualTy then + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None + else + let adjustedTy, _, _ = AdjustRequiredTypeForTypeDirectedConversions infoReader ad isMethodArg isConstraint underlyingTy actualTy m + if typeEquiv g adjustedTy actualTy then + actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true), None + else + reqdTy, TypeDirectedConversionUsed.No, None + // Adhoc based on op_Implicit, perhaps returing a new equational type constraint to // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn + | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None @@ -352,9 +367,8 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO // If inference has worked out it's a struct (e.g. an int) then use this elif isStructTy g callerArgTy then - let calledArgTy2 = destNullableTy g calledArgTy - AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy2 callerArgTy m - + AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy callerArgTy m + // If neither and we are at the end of overload resolution then use the Nullable elif enforceNullableOptionalsKnownTypes then calledArgTy, TypeDirectedConversionUsed.No, None @@ -1305,6 +1319,16 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade mkCallToDoubleOperator g m actualTy expr + elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && + isNullableTy g reqdTy && not (isNullableTy g actualTy) then + + let underlyingTy = destNullableTy g reqdTy + let adjustedExpr = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad underlyingTy actualTy m expr + let adjustedActualTy = tyOfExpr g adjustedExpr + + let minfo = GetIntrinsicConstructorInfosOfType infoReader m reqdTy |> List.head + let callerArgExprCoerced = mkCoerceIfNeeded g underlyingTy adjustedActualTy adjustedExpr + MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None else match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with | Some (minfo, staticTy, _) -> @@ -1313,9 +1337,7 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy) callExpr - | None -> mkCoerceIfNeeded g reqdTy actualTy expr - // TODO: consider Nullable - + | None -> mkCoerceIfNeeded g reqdTy actualTy expr // Handle adhoc argument conversions let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr = @@ -1450,17 +1472,6 @@ let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCal let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr) preBinder, { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg } -let MakeNullableExprIfNeeded (infoReader: InfoReader) calledArgTy callerArgTy callerArgExpr m = - let g = infoReader.g - let amap = infoReader.amap - if isNullableTy g callerArgTy then - callerArgExpr - else - let calledNonOptTy = destNullableTy g calledArgTy - let minfo = GetIntrinsicConstructorInfosOfType infoReader m calledArgTy |> List.head - let callerArgExprCoerced = mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr - MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None - // Adjust all the optional arguments, filling in values for defaults, let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) = let g = infoReader.g @@ -1492,14 +1503,9 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: | NotOptional -> // T --> Nullable widening at callsites if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(), m)) - if isNullableTy g calledArgTy then - if isNullableTy g callerArgTy then - callerArgExpr - else - let calledNonOptTy = destNullableTy g calledArgTy - let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr - let callerArgTy2 = tyOfExpr g callerArgExpr2 - MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m + if isNullableTy g calledArgTy then + // AdjustCallerArgExpr later on will deal with the nullable conversion + callerArgExpr else failwith "unreachable" // see case above @@ -1521,21 +1527,8 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // This should be unreachable but the error will be reported elsewhere callerArgExpr else - if isNullableTy g calledArgTy then - if isNullableTy g callerArgTy then - // CSharpMethod(x=b) when 'x' has nullable type - // CSharpMethod(x=b) when both 'x' and 'b' have nullable type --> CSharpMethod(x=b) - callerArgExpr - else - // CSharpMethod(x=b) when 'x' has nullable type and 'b' does not --> CSharpMethod(x=Nullable(b)) - let calledNonOptTy = destNullableTy g calledArgTy - let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr - let callerArgTy2 = tyOfExpr g callerArgExpr2 - MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m - else - // CSharpMethod(x=b) --> CSharpMethod(?x=b) - let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m callerArgExpr - callerArgExpr2 + // AdjustCallerArgExpr later on will deal with any nullable conversion + callerArgExpr | CalleeSide -> if isOptCallerArg then diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index ad5bb10ebaa..a70827d8fec 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -119,7 +119,7 @@ type CallerArgs<'T> = /// has been used in F# code [] type TypeDirectedConversionUsed = - | Yes of (DisplayEnv -> exn) + | Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool | No static member Combine: TypeDirectedConversionUsed -> TypeDirectedConversionUsed -> TypeDirectedConversionUsed diff --git a/tests/fsharp/Compiler/Language/OptionalInteropTests.fs b/tests/fsharp/Compiler/Language/OptionalInteropTests.fs index 646692eeb03..2e099bfe5b9 100644 --- a/tests/fsharp/Compiler/Language/OptionalInteropTests.fs +++ b/tests/fsharp/Compiler/Language/OptionalInteropTests.fs @@ -6,15 +6,14 @@ open System.Collections.Immutable open NUnit.Framework open FSharp.Test open FSharp.Test.Utilities -open FSharp.Test.Compiler -open FSharp.Compiler.Diagnostics open Microsoft.CodeAnalysis [] module OptionalInteropTests = - [] - let ``C# method with an optional parameter and called with an option type should compile`` () = + [] + [] + let ``C# method with an optional parameter and called with an option type should compile`` langVersion = let csSrc = """ using Microsoft.FSharp.Core; @@ -145,6 +144,10 @@ Test.MethodTakingNullables(6, y="aaaaaa", d=Nullable 8.0) |> ignore Test.MethodTakingNullables(6, y="aaaaaa", d=Nullable ()) |> ignore Test.MethodTakingNullables(Nullable (), y="aaaaaa", d=8.0) |> ignore Test.MethodTakingNullables(Nullable 6, y="aaaaaa", d=8.0) |> ignore + +Test.OverloadedMethodTakingNullableOptionalsWithDefaults(x = 6) |> ignore +Test.OverloadedMethodTakingNullables(6, "aaaaaa", 8.0) |> ignore +Test.OverloadedMethodTakingNullableOptionals(x = 6) |> ignore """ let fsharpCoreAssembly = @@ -155,5 +158,6 @@ Test.MethodTakingNullables(Nullable 6, y="aaaaaa", d=8.0) |> ignore CompilationUtil.CreateCSharpCompilation(csSrc, CSharpLanguageVersion.CSharp8, TargetFramework.NetCoreApp31, additionalReferences = ImmutableArray.CreateRange [fsharpCoreAssembly]) |> CompilationReference.Create - let fs = Compilation.Create(fsSrc, CompileOutput.Exe, options = [|"--langversion:5.0"|], cmplRefs = [cs]) + let fs = Compilation.Create(fsSrc, CompileOutput.Exe, options = [| $"--langversion:{langVersion}" |], cmplRefs = [cs]) CompilerAssert.Compile fs + diff --git a/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs new file mode 100644 index 00000000000..be31e72712e --- /dev/null +++ b/tests/fsharp/Compiler/Language/TypeDirectedConversionTests.fs @@ -0,0 +1,442 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework +open FSharp.Test +open FSharp.Compiler.Diagnostics + +[] +module TypeDirectedConversionTests = + [] + let ``int32 converts to float in method call parameter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + static member Do(i: float) = () + +let test() = Thing.Do(100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static void test() cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.s 100 + IL_0002: conv.r8 + IL_0003: call void Test/Thing::Do(float64) + IL_0008: ret + } + """ + ])) + + [] + let ``int32 converts to System.Nullable in method call parameter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + static member Do(i: System.Nullable) = () + +let test() = Thing.Do(100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static void test() cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.s 100 + IL_0002: conv.r8 + IL_0003: newobj instance void valuetype [runtime]System.Nullable`1::.ctor(!0) + IL_0008: call void Test/Thing::Do(valuetype [runtime]System.Nullable`1) + IL_000d: ret + } + """ + ])) + + [] + let ``int32 converts to float in method call property setter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + member val Do: float = 0.0 with get,set + +let test() = Thing(Do = 100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static class Test/Thing + test() cil managed + { + + .maxstack 4 + .locals init (class Test/Thing V_0) + IL_0000: newobj instance void Test/Thing::.ctor() + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: ldc.i4.s 100 + IL_0009: conv.r8 + IL_000a: callvirt instance void Test/Thing::set_Do(float64) + IL_000f: ldloc.0 + IL_0010: ret + } + """ + ])) + + + [] + let ``int32 converts to System.Nullable in method call property setter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + member val Do: System.Nullable = System.Nullable() with get,set + +let test() = Thing(Do = 100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static class Test/Thing + test() cil managed + { + + .maxstack 4 + .locals init (class Test/Thing V_0) + IL_0000: newobj instance void Test/Thing::.ctor() + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: ldc.i4.s 100 + IL_0009: conv.r8 + IL_000a: newobj instance void valuetype [runtime]System.Nullable`1::.ctor(!0) + IL_000f: callvirt instance void Test/Thing::set_Do(valuetype [runtime]System.Nullable`1) + IL_0014: ldloc.0 + IL_0015: ret + } + """ + ])) + + [] + let ``int converts to System.Nullable in method call property setter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + member val Do: System.Nullable = System.Nullable() with get,set + +let test() = Thing(Do = 100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static class Test/Thing + test() cil managed + { + + .maxstack 4 + .locals init (class Test/Thing V_0) + IL_0000: newobj instance void Test/Thing::.ctor() + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: ldc.i4.s 100 + IL_0009: newobj instance void valuetype [runtime]System.Nullable`1::.ctor(!0) + IL_000e: callvirt instance void Test/Thing::set_Do(valuetype [runtime]System.Nullable`1) + IL_0013: ldloc.0 + IL_0014: ret + } + """ + ])) + + [] + let ``int converts to System.Nullable in method call parameter``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Thing() = + static member Do(i: System.Nullable) = () + +let test() = Thing.Do(100) + """, + (fun verifier -> verifier.VerifyIL [ + """ + .method public static void test() cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.s 100 + IL_0002: newobj instance void valuetype [runtime]System.Nullable`1::.ctor(!0) + IL_0007: call void Test/Thing::Do(valuetype [runtime]System.Nullable`1) + IL_000c: ret + } + """ + ])) + + [] + let ``Passing an incompatible argument for System.Nullable<'T> method call parameter produces accurate error``() = + CompilerAssert.TypeCheckSingleError + """ +module Test + +type Thing() = + static member Do(i: System.Nullable) = () + +let test() = Thing.Do(true) + """ + FSharpDiagnosticSeverity.Error + 193 + (7, 22, 7, 28) + """Type constraint mismatch. The type + 'bool' +is not compatible with type + 'System.Nullable' +""" + + [] + let ``Assigning a 'T value to a System.Nullable<'T> binding succeeds``() = + CompilerAssert.TypeCheckSingleError + """ +module Test + +let test(): System.Nullable = 1 +""" + FSharpDiagnosticSeverity.Warning + 3391 + (4, 36, 4, 37) + """This expression uses the implicit conversion 'System.Nullable.op_Implicit(value: int) : System.Nullable' to convert type 'int' to type 'System.Nullable'. See https://aka.ms/fsharp-implicit-convs. This warning may be disabled using '#nowarn "3391".""" + + [] + let ``Assigning an int32 to a System.Nullable binding fails``() = + CompilerAssert.TypeCheckSingleError + """ +module Test + +let test(): System.Nullable = 1 +""" + FSharpDiagnosticSeverity.Error + 1 + (4, 38, 4, 39) + """This expression was expected to have type + 'System.Nullable' +but here has type + 'int' """ + + [] + let ``Overloading on System.Nullable and Result both work without error``() = + CompilerAssert.Pass + """ +module Test + +type M() = + static member A(n: System.Nullable<'T>) = () + static member A(r: Result<'T, 'TError>) = () + +let test() = + M.A(System.Nullable 3) + M.A(Result.Ok 3) +""" + + + [] + let ``Overloading on System.Nullable and Result produces a builtin conversion warning when Nullable is picked``() = + CompilerAssert.TypeCheckSingleErrorWithOptions + [| "--warnon:3389" |] + """ +module Test + +type M() = + static member A(n: System.Nullable) = () + static member A(r: Result<'T, 'TError>) = () + +let test() = + M.A(3) +""" + FSharpDiagnosticSeverity.Warning + 3389 + (9, 9, 9, 10) + """This expression uses a built-in implicit conversion to convert type 'int' to type 'System.Nullable'. See https://aka.ms/fsharp-implicit-convs.""" + + [] + let ``Overloading on System.Nullable, System.Nullable<'T> and int all work without error``() = + CompilerAssert.RunScript + """ +let assertTrue x = + (x || failwith "Unexpected overload") |> ignore + +type M() = + static member A(n: System.Nullable<'T>) = 1 + static member A(n: System.Nullable) = 2 + static member A(n: int) = 3 + +let test() = + M.A(System.Nullable 3.) = 1 |> assertTrue + M.A(System.Nullable 3) = 2 |> assertTrue + M.A(3) = 3 |> assertTrue + +test() + """ [] + + [] + let ``Picking overload for typar does not favor any form of System.Nullable nor produce ambiguity warnings``() = + CompilerAssert.TypeCheckSingleError + """ +module Test + +type M() = + static member A(n: System.Nullable<'T>) = () +// static member A(n: System.Nullable) = () + static member A(n: System.Nullable) = () + static member A(n: int) = () + +let test(x: 'T) = + M.A(x) +""" + FSharpDiagnosticSeverity.Warning + 64 + (11, 5, 11, 11) + """This construct causes code to be less generic than indicated by the type annotations. The type variable 'T has been constrained to be type 'int'.""" + + [] + let ``Picking overload for typar fails when incompatible types are part of the candidate set``() = + CompilerAssert.TypeCheckWithErrors + """ +module Test + +type M() = + static member A(n: System.Nullable<'T>) = () + static member A(n: System.Nullable) = () + static member A(n: System.Nullable) = () + static member A(n: int) = () + +let test(x: 'T) = + M.A(x) + +type M2() = + static member A(n: System.Nullable) = () + static member A(n: System.Nullable) = () + static member A(n: int) = () + +let test2(x: 'T) = + M2.A(x) +""" + [| + (FSharpDiagnosticSeverity.Error, + 41, + (11, 5, 11, 11), + """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known type of argument: 'T + +Candidates: + - static member M.A: n: System.Nullable<'T> -> unit when 'T: (new: unit -> 'T) and 'T: struct and 'T :> System.ValueType + - static member M.A: n: System.Nullable -> unit + - static member M.A: n: System.Nullable -> unit + - static member M.A: n: int -> unit""") + (FSharpDiagnosticSeverity.Error, + 41, + (19, 5, 19, 12), + """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known type of argument: 'T + +Candidates: + - static member M2.A: n: System.Nullable -> unit + - static member M2.A: n: System.Nullable -> unit + - static member M2.A: n: int -> unit""") + |] + + [] + let ``Ambiguous overload for typar does not pick System.Nullable<'T>``() = + CompilerAssert.TypeCheckSingleError + """ +module Test + +type M() = + static member A(n: System.Nullable<'T>) = () + static member A(n: int) = () + static member A(n: float) = () + +let test(x: 'T) = + M.A(x) +""" + FSharpDiagnosticSeverity.Error + 41 + (10, 5, 10, 11) + """A unique overload for method 'A' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known type of argument: 'T + +Candidates: + - static member M.A: n: System.Nullable<'T> -> unit when 'T: (new: unit -> 'T) and 'T: struct and 'T :> System.ValueType + - static member M.A: n: float -> unit + - static member M.A: n: int -> unit""" + + [] + let ``Passing an argument in nested method call property setter works``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions([|"--optimize-"|], + """ +module Test + +type Input<'T>(_v: 'T) = + static member op_Implicit(value: 'T): Input<'T> = Input<'T>(value) + +type OtherArgs() = + member val Name: string = Unchecked.defaultof<_> with get,set +type SomeArgs() = + member val OtherArgs: Input = Unchecked.defaultof<_> with get, set + +let test() = + SomeArgs(OtherArgs = OtherArgs(Name = "test")) +""" + , + (fun verifier -> verifier.VerifyIL [ + """ + .method public static class Test/SomeArgs + test() cil managed + { + + .maxstack 5 + .locals init (class Test/SomeArgs V_0, + class Test/OtherArgs V_1) + IL_0000: newobj instance void Test/SomeArgs::.ctor() + IL_0005: stloc.0 + IL_0006: ldloc.0 + IL_0007: newobj instance void Test/OtherArgs::.ctor() + IL_000c: stloc.1 + IL_000d: ldloc.1 + IL_000e: ldstr "test" + IL_0013: callvirt instance void Test/OtherArgs::set_Name(string) + IL_0018: ldloc.1 + IL_0019: call class Test/Input`1 class Test/Input`1::op_Implicit(!0) + IL_001e: callvirt instance void Test/SomeArgs::set_OtherArgs(class Test/Input`1) + IL_0023: ldloc.0 + IL_0024: ret + } + """ + ])) + + [] + let ``Test retrieving an argument provided in a nested method call property setter works``() = + CompilerAssert.RunScript + """ +type Input<'T>(v: 'T) = + member _.Value = v + static member op_Implicit(value: 'T): Input<'T> = Input<'T>(value) + +type OtherArgs() = + member val Name: string = Unchecked.defaultof<_> with get,set +type SomeArgs() = + member val OtherArgs: Input = Unchecked.defaultof<_> with get, set + +let test() = + SomeArgs(OtherArgs = OtherArgs(Name = "test")) + +if not (test().OtherArgs.Value.Name = "test") then failwith "Unexpected value was returned after setting Name" + """ [] diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 6e1daff174e..6e38d801d1f 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -71,6 +71,7 @@ +