Warn when obj is inferred

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 = 

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
+
+    [<Theory>]
+    [<MemberData(nameof(warningCases))>]
+    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<obj> 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<int> 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<[<Measure>]'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<int>" // explicitly int
+            "let f () = Unchecked.defaultof<_>" // generic
+        ]
+        |> List.map Array.singleton
+
+    let noWarningCases = quotableNoWarningCases @ unquotableNoWarningCases
+
+    [<Theory>]
+    [<MemberData(nameof(noWarningCases))>]
+    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
+
+    [<Theory>]
+    [<MemberData(nameof(nullNoWarningCases))>]
+    let ``Don't warn on an explicitly annotated null``(expr: string) =
+        sprintf "%s |> ignore" expr
+        |> FSharp
+        |> withWarnOn 3559
+        |> withLangVersionPreview
+        |> typecheck
+        |> shouldSucceed
+
+    [<Theory>]
+    [<MemberData(nameof(nullNoWarningCases))>]
+    let ``Don't warn on an explicitly annotated null, inside quotations``(expr: string) =
+        sprintf "<@ %s @> |> ignore" expr
+        |> FSharp
+        |> withWarnOn 3559
+        |> withLangVersionPreview
+        |> typecheck
+        |> shouldSucceed
+
+    [<Theory>]
+    [<MemberData(nameof(quotableWarningCases))>]
+    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)
+
+    [<Theory>]
+    [<MemberData(nameof(quotableNoWarningCases))>]
+    let ``Don't warn inside quotations of acceptable code``(expr: string) =
+        sprintf "<@ %s @> |> ignore" expr
+        |> FSharp
+        |> withWarnOn 3559
+        |> withLangVersionPreview
+        |> typecheck
+        |> shouldSucceed
+
+    [<Theory>]
+    [<MemberData(nameof(warningCases))>]
+    let ``Warning is off by default``(expr: string, _: int, _: int, _: int, _: int) =
+        expr
+        |> FSharp
+        |> withLangVersionPreview
+        |> withOptions ["--warnaserror"]
+        |> typecheck
+        |> shouldSucceed

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -190,6 +190,7 @@
 	<Compile Include="Language\CopyAndUpdateTests.fs" />
     <Compile Include="ConstraintSolver\PrimitiveConstraints.fs" />
     <Compile Include="ConstraintSolver\MemberConstraints.fs" />
+    <Compile Include="ConstraintSolver\ObjInference.fs" />
     <Compile Include="Interop\DeeplyNestedCSharpClasses.fs" />
     <Compile Include="Interop\SimpleInteropTests.fs" />
     <Compile Include="Interop\RequiredAndInitOnlyProperties.fs" />