diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index 90d5bed1fcb..49afd4825b6 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -4,6 +4,7 @@ /// constraint solving and method overload resolution. module internal FSharp.Compiler.TypeRelations +open FSharp.Compiler.Features open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler.DiagnosticsLogger @@ -134,50 +135,58 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = /// Here x gets a generalized type "list<'T>". let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = let m = tp.Range - let maxTy, m = + let (maxTy, isRefined), m = let initialTy = match tp.Kind with | TyparKind.Type -> g.obj_ty | TyparKind.Measure -> TType_measure Measure.One // Loop through the constraints computing the lub - ((initialTy, m), tp.Constraints) ||> List.fold (fun (maxTy, _) tpc -> + (((initialTy, false), m), tp.Constraints) ||> List.fold (fun ((maxTy, isRefined), _) tpc -> let join m x = - if TypeFeasiblySubsumesType 0 g amap m x CanCoerce maxTy then maxTy - elif TypeFeasiblySubsumesType 0 g amap m maxTy CanCoerce x then x - else errorR(Error(FSComp.SR.typrelCannotResolveImplicitGenericInstantiation((DebugPrint.showType x), (DebugPrint.showType maxTy)), m)); maxTy + if TypeFeasiblySubsumesType 0 g amap m x CanCoerce maxTy then maxTy, isRefined + elif TypeFeasiblySubsumesType 0 g amap m maxTy CanCoerce x then x, true + else errorR(Error(FSComp.SR.typrelCannotResolveImplicitGenericInstantiation((DebugPrint.showType x), (DebugPrint.showType maxTy)), m)); maxTy, isRefined // Don't continue if an error occurred and we set the value eagerly - if tp.IsSolved then maxTy, m else + if tp.IsSolved then (maxTy, isRefined), m else match tpc with | TyparConstraint.CoercesTo(x, m) -> join m x, m | TyparConstraint.MayResolveMember(_traitInfo, m) -> - maxTy, m + (maxTy, isRefined), m | TyparConstraint.SimpleChoice(_, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInPrintf(), m)) - maxTy, m + (maxTy, isRefined), m | TyparConstraint.SupportsNull m -> - maxTy, m + (maxTy, isRefined), m | TyparConstraint.SupportsComparison m -> join m g.mk_IComparable_ty, m | TyparConstraint.SupportsEquality m -> - maxTy, m + (maxTy, isRefined), m | TyparConstraint.IsEnum(_, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInEnum(), m)) - maxTy, m + (maxTy, isRefined), m | TyparConstraint.IsDelegate(_, _, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInDelegate(), m)) - maxTy, m + (maxTy, isRefined), m | TyparConstraint.IsNonNullableStruct m -> join m g.int_ty, m | TyparConstraint.IsUnmanaged m -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInUnmanaged(), m)) - maxTy, m + (maxTy, isRefined), m | TyparConstraint.RequiresDefaultConstructor m -> - maxTy, m + (maxTy, isRefined), m | TyparConstraint.IsReferenceType m -> - maxTy, m + (maxTy, isRefined), m | TyparConstraint.DefaultsTo(_priority, _ty, m) -> - maxTy, m) + (maxTy, isRefined), m) + + if g.langVersion.SupportsFeature LanguageFeature.DiagnosticForObjInference then + match tp.Kind with + | TyparKind.Type -> + if not isRefined then + informationalWarning(Error(FSComp.SR.typrelNeverRefinedAwayFromTop(), m)) + | TyparKind.Measure -> () + maxTy, m let ChooseTyparSolution g amap tp = diff --git a/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/ObjInference.fs b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/ObjInference.fs new file mode 100644 index 00000000000..358e10a2fa4 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/ObjInference.fs @@ -0,0 +1,139 @@ +namespace FSharp.Compiler.ComponentTests.ConstraintSolver + +open Xunit +open FSharp.Test.Compiler + +module ObjInference = + + let message = "A type has been implicitly inferred as 'obj', which may be unintended. Consider adding explicit type annotations. You can disable this warning by using '#nowarn \"3559\"' or '--nowarn:3559'." + + let quotableWarningCases = + [ + """System.Object.ReferenceEquals(null, "hello") |> ignore""", 1, 31, 1, 35 + """System.Object.ReferenceEquals("hello", null) |> ignore""", 1, 40, 1, 44 + "([] = []) |> ignore", 1, 7, 1, 9 + "<@ [] = [] @> |> ignore", 1, 9, 1, 11 + "let _ = Unchecked.defaultof<_> in ()", 1, 29, 1, 30 + ] + |> List.map (fun (str, line1, col1, line2, col2) -> [| box str ; line1 ; col1 ; line2 ; col2 |]) + + let unquotableWarningCases = + [ + "let f() = ([] = [])", 1, 17, 1, 19 + """let f<'b> (x : 'b) : int = failwith "" +let deserialize<'v> (s : string) : 'v = failwith "" +let x = deserialize "" |> f""", 3, 9, 3, 28 + "let f = typedefof<_>", 1, 19, 1, 20 + """let f<'b> () : 'b = (let a = failwith "" in unbox a)""", 1, 26, 1, 27 + ] + |> List.map (fun (str, line1, col1, line2, col2) -> [| box str ; line1 ; col1 ; line2 ; col2 |]) + + let warningCases = + quotableWarningCases @ unquotableWarningCases + + [] + [] + let ``Warning is emitted when type Obj is inferred``(code: string, line1: int, col1: int, line2: int, col2: int) = + FSharp code + |> withErrorRanges + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Information 3559, Line line1, Col col1, Line line2, Col col2, message) + + let quotableNoWarningCases = + [ + "let a = 5 |> unbox in let b = a in ()" // explicit obj annotation + "let add x y = x + y in ()" // inferred as int + "let f() = ([] = ([] : obj list)) in ()" // obj is inferred, but is annotated + "let f() = (([] : obj list) = []) in ()" // obj is inferred, but is annotated + "let f () : int = Unchecked.defaultof<_> in ()" // explicitly int + "let f () = Unchecked.defaultof in ()" // explicitly int + ] + |> List.map Array.singleton + + let unquotableNoWarningCases = + [ + "let add x y = x + y" // inferred as int + "let inline add x y = x + y" // inferred with SRTP + "let inline add< ^T when ^T : (static member (+) : ^T * ^T -> ^T)> (x : ^T) (y : ^T) : ^T = x + y" // with SRTP + "let f x = string x" // inferred as generic 'a -> string + "let f() = ([] = ([] : obj list))" // obj is inferred, but is annotated + "let f() = (([] : obj list) = [])" // obj is inferred, but is annotated + """let x<[]'m> : int<'m> = failwith "" +let f () = x = x |> ignore""" // measure is inferred as 1, but that's not covered by this warning + "let f () : int = Unchecked.defaultof<_>" // explicitly int + "let f () = Unchecked.defaultof" // explicitly int + "let f () = Unchecked.defaultof<_>" // generic + ] + |> List.map Array.singleton + + let noWarningCases = quotableNoWarningCases @ unquotableNoWarningCases + + [] + [] + let ``Warning does not fire unless required``(code: string) = + FSharp code + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + let nullNoWarningCases = + [ + """System.Object.ReferenceEquals("hello", (null: string))""" + """System.Object.ReferenceEquals((null: string), "hello")""" + ] + |> List.map Array.singleton + + [] + [] + let ``Don't warn on an explicitly annotated null``(expr: string) = + sprintf "%s |> ignore" expr + |> FSharp + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + [] + let ``Don't warn on an explicitly annotated null, inside quotations``(expr: string) = + sprintf "<@ %s @> |> ignore" expr + |> FSharp + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + [] + let ``Warn also inside quotations of acceptable code``(expr: string, line1: int, col1: int, line2: int, col2: int) = + sprintf "<@ %s @> |> ignore" expr + |> FSharp + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Information 3559, Line line1, Col (col1 + 3), Line line2, Col (col2 + 3), message) + + [] + [] + let ``Don't warn inside quotations of acceptable code``(expr: string) = + sprintf "<@ %s @> |> ignore" expr + |> FSharp + |> withWarnOn 3559 + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + + [] + [] + let ``Warning is off by default``(expr: string, _: int, _: int, _: int, _: int) = + expr + |> FSharp + |> withLangVersionPreview + |> withOptions ["--warnaserror"] + |> typecheck + |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 45f82c3778c..f1b7a10f14b 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -193,6 +193,7 @@ +