Diagnostics: add extended data for 'No constructors' error

Author: auduchinok

src/Compiler/Checking/CheckDeclarations.fs

@@ -1370,7 +1370,8 @@ module MutRecBindingChecking =
                                 try
                                    let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy
                                    let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g
-                                   TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m
+                                   let mTcNew = unionRanges synBaseTy.Range arg.Range
+                                   TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg mTcNew
                                 with RecoverableException e ->
                                     errorRecovery e m
                                     mkUnit g m, tpenv

src/Compiler/Checking/NameResolution.fs

@@ -38,6 +38,8 @@ open FSharp.Compiler.TypeHierarchy
 open FSharp.Compiler.TypeProviders
 #endif
 
+exception NoConstructorsAvailableForType of TType * DisplayEnv * range
+
 /// An object that captures the logical context for name resolution.
 type NameResolver(g: TcGlobals,
                   amap: Import.ImportMap,
@@ -2554,7 +2556,7 @@ let private ResolveObjectConstructorPrim (ncenv: NameResolver) edenv resInfo m a
                     [DefaultStructCtor(g, ty)]
                 else []
             if (isNil defaultStructCtorInfo && isNil ctorInfos) || (not (isAppTy g ty) && not (isAnyTupleTy g ty)) then
-                raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv ty), m))
+                raze (error(NoConstructorsAvailableForType(ty, edenv, m)))
             else
                 let ctorInfos = ctorInfos |> List.filter (IsMethInfoAccessible amap m ad)
                 let metadataTy = convertToTypeWithMetadataIfPossible g ty

src/Compiler/Checking/NameResolution.fsi

@@ -14,6 +14,8 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TcGlobals
 
+exception NoConstructorsAvailableForType of TType * DisplayEnv * range
+
 /// A NameResolver is a context for name resolution. It primarily holds an InfoReader.
 type NameResolver =
 

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -44,34 +44,24 @@ open FSharp.Compiler.TypedTreeOps
 let showAssertForUnexpectedException = ref true
 #endif
 
-/// This exception is an old-style way of reporting a diagnostic
 exception HashIncludeNotAllowedInNonScript of range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception HashReferenceNotAllowedInNonScript of range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception HashLoadedSourceHasIssues of informationals: exn list * warnings: exn list * errors: exn list * range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception HashLoadedScriptConsideredSource of range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception HashDirectiveNotAllowedInNonScript of range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception DeprecatedCommandLineOptionFull of string * range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception DeprecatedCommandLineOptionForHtmlDoc of string * range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception DeprecatedCommandLineOptionSuggestAlternative of string * string * range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception DeprecatedCommandLineOptionNoDescription of string * range
 
-/// This exception is an old-style way of reporting a diagnostic
 exception InternalCommandLineOption of string * range
 
 type Exception with
@@ -207,7 +197,9 @@ type Exception with
         | MSBuildReferenceResolutionError(_, _, m)
         | AssemblyNotResolved(_, m)
         | HashLoadedSourceHasIssues(_, _, _, m)
-        | HashLoadedScriptConsideredSource m -> Some m
+        | HashLoadedScriptConsideredSource m
+        | NoConstructorsAvailableForType(_, _, m) -> Some m
+
         // Strip TargetInvocationException wrappers
         | :? System.Reflection.TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticRange
 #if !NO_TYPEPROVIDERS
@@ -336,6 +328,7 @@ type Exception with
         | PatternMatchCompilation.EnumMatchIncomplete _ -> 104
         | Failure _ -> 192
         | DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer _ -> 318
+        | NoConstructorsAvailableForType _ -> 1133
         | ArgumentsInSigAndImplMismatch _ -> 3218
 
         // Strip TargetInvocationException wrappers
@@ -616,6 +609,8 @@ module OldStyleMessages =
     let InvalidAttributeTargetForLanguageElement1E () = Message("InvalidAttributeTargetForLanguageElement1", "%s%s")
     let InvalidAttributeTargetForLanguageElement2E () = Message("InvalidAttributeTargetForLanguageElement2", "")
 
+    let NoConstructorsAvailableForTypeE () = Message("NoConstructorsAvailableForType", "%s")
+
 #if DEBUG
 let mutable showParserStackOnParseError = false
 #endif
@@ -1945,6 +1940,9 @@ type Exception with
                 let allowedTargets = allowedTargets |> String.concat ", "
                 os.AppendString(InvalidAttributeTargetForLanguageElement1E().Format elementTargets allowedTargets)
 
+        | NoConstructorsAvailableForType(t, denv, _) ->
+            os.AppendString(NoConstructorsAvailableForTypeE().Format(NicePrint.minimalStringOfType denv t))
+
         // Strip TargetInvocationException wrappers
         | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).Output(os, suggestNames)
 

src/Compiler/FSStrings.resx

@@ -1152,4 +1152,7 @@
   <data name="InvalidAttributeTargetForLanguageElement2" xml:space="preserve">
     <value>This attribute is not valid for use on this language element</value>
   </data>
+  <data name="NoConstructorsAvailableForType" xml:space="preserve">
+    <value>No constructors are available for the type '{0}'</value>
+  </data>
 </root>

src/Compiler/Symbols/FSharpDiagnostic.fs

@@ -11,6 +11,7 @@ open System
 
 open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.ConstraintSolver
+open FSharp.Compiler.NameResolution
 open FSharp.Compiler.SignatureConformance
 open FSharp.Compiler.Symbols
 open FSharp.Compiler.Syntax
@@ -86,6 +87,12 @@ module ExtendedData =
         member x.ContextInfo = context
         member x.DisplayContext = FSharpDisplayContext(fun _ -> dispEnv)
 
+    type TypeExtendedData internal (symbolEnv: SymbolEnv, displayEnv: DisplayEnv, actualType: TType) =
+        interface IFSharpDiagnosticExtendedData
+
+        member x.Type = FSharpType(symbolEnv, actualType)
+        member x.DisplayContext = FSharpDisplayContext(fun _ -> displayEnv)
+
     type ExpressionIsAFunctionExtendedData internal (symbolEnv: SymbolEnv, actualType: TType) =
         interface IFSharpDiagnosticExtendedData
 
@@ -203,11 +210,15 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
             | DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(implTycon = implTycon; sigTycon = sigTycon) ->
                 Some(DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData(sigTycon, implTycon))
 
-            | ObsoleteDiagnostic(diagnosticId= diagnosticId; urlFormat= urlFormat) ->
+            | ObsoleteDiagnostic(diagnosticId = diagnosticId; urlFormat = urlFormat) ->
                 Some(ObsoleteDiagnosticExtendedData(diagnosticId, urlFormat))
 
-            | Experimental(diagnosticId= diagnosticId; urlFormat= urlFormat) ->
+            | Experimental(diagnosticId = diagnosticId; urlFormat = urlFormat) ->
                 Some(ExperimentalExtendedData(diagnosticId, urlFormat))
+
+            | NoConstructorsAvailableForType(ttype, displayEnv, _) ->
+                Some(TypeExtendedData(symbolEnv, displayEnv, ttype))
+
             | _ -> None
 
         let msg =

src/Compiler/Symbols/FSharpDiagnostic.fsi

@@ -99,6 +99,13 @@ module ExtendedData =
         /// Represents the information needed to format types
         member DisplayContext: FSharpDisplayContext
 
+    [<Class>]
+    type TypeExtendedData =
+        interface IFSharpDiagnosticExtendedData
+
+        member Type: FSharpType
+        member DisplayContext: FSharpDisplayContext
+
     /// Additional data for 'This expression is a function value, i.e. is missing arguments' diagnostic
     [<Class>]
     type ExpressionIsAFunctionExtendedData =