diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json index bbae4ecb698..6e0c412215d 100644 --- a/.devcontainer/devcontainer.json +++ b/.devcontainer/devcontainer.json @@ -1,12 +1,12 @@ // For format details, see https://aka.ms/vscode-remote/devcontainer.json or this file's README at: { "name": "F#", - "image": "mcr.microsoft.com/dotnet/sdk:9.0.100", + "image": "mcr.microsoft.com/dotnet/sdk:9.0.102", "features": { - "ghcr.io/devcontainers/features/common-utils:2.5.1": {}, + "ghcr.io/devcontainers/features/common-utils:2.5.2": {}, "ghcr.io/devcontainers/features/git:1.3.2": {}, "ghcr.io/devcontainers/features/github-cli:1.0.13": {}, - "ghcr.io/devcontainers/features/dotnet:2.1.3": {} + "ghcr.io/devcontainers/features/dotnet:2.2.0": {} }, "hostRequirements": { "cpus": 2, diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md index 66888c7cebe..52b92207001 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md @@ -1,13 +1,14 @@ ### Fixed - * Fix Realsig+ generates nested closures with incorrect Generic ([Issue #17797](https://github.com/dotnet/fsharp/issues/17797), [PR #17877](https://github.com/dotnet/fsharp/pull/17877)) +* Fix internal error when missing measure attribute in an unsolved measure typar. ([Issue #7491](https://github.com/dotnet/fsharp/issues/7491), [PR #18234](https://github.com/dotnet/fsharp/pull/18234)== * Set `Cancellable.token` from async computation ([Issue #18235](https://github.com/dotnet/fsharp/issues/18235), [PR #18238](https://github.com/dotnet/fsharp/pull/18238)) ### Added - +* Added missing type constraints in FCS. ([PR #18241](https://github.com/dotnet/fsharp/pull/18241)) ### Changed +* FSharpCheckFileResults.ProjectContext.ProjectOptions will not be available when using the experimental Transparent Compiler feature. ([PR #18205](https://github.com/dotnet/fsharp/pull/18205)) +* Update `Obsolete` attribute checking to account for `DiagnosticId` and `UrlFormat` properties. ([PR #18224](https://github.com/dotnet/fsharp/pull/18224)) ### Breaking Changes - diff --git a/eng/DotNetBuild.props b/eng/DotNetBuild.props index d1681803391..b44b8bae3b4 100644 --- a/eng/DotNetBuild.props +++ b/eng/DotNetBuild.props @@ -31,6 +31,7 @@ --tfm $(SourceBuildBootstrapTfm) false + /p:RestoreConfigFile=$(RestoreConfigFile) diff --git a/eng/Versions.props b/eng/Versions.props index 59f0f6e7cb9..3b36ad6a716 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -37,7 +37,7 @@ $(FSMajorVersion).$(FSMinorVersion).$(FSBuildVersion) - 9.0.100 + 9.0.101 $(FSCorePackageVersionValue)-$(PreReleaseVersionLabel).* diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs old mode 100644 new mode 100755 index 563af942829..8c317ad5f31 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -24,8 +24,12 @@ open FSharp.Compiler.TypeProviders open FSharp.Core.CompilerServices #endif -exception ObsoleteWarning of string * range -exception ObsoleteError of string * range +exception ObsoleteDiagnostic of + isError: bool * + diagnosticId: string * + message: string * + urlFormat: string * + range: range let fail() = failwith "This custom attribute has an argument that cannot yet be converted using this API" @@ -234,7 +238,6 @@ let MethInfoHasAttribute g m attribSpec minfo = (fun _ -> Some ()) |> Option.isSome - let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute. // Specifically, when default constructor is generated for class with any required members in them. @@ -244,87 +247,160 @@ let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = | Some([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" -> CompleteD | _ -> - ErrorD (ObsoleteError(msg, m)) + ErrorD (ObsoleteDiagnostic(true, "", msg, "", m)) + +let private extractILObsoleteAttributeInfo namedArgs = + let extractILAttribValueFrom name namedArgs = + match namedArgs with + | ExtractILAttributeNamedArg name (AttribElemStringArg v) -> v + | _ -> "" + let diagnosticId = extractILAttribValueFrom "DiagnosticId" namedArgs + let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs + (diagnosticId, urlFormat) + +let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = + if isByrefLikeTyconRef then + CompleteD + else + let (AttribInfo(tref,_)) = g.attrib_SystemObsolete + match TryDecodeILAttribute tref cattrs with + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // Constructors deciding on IsError and Message properties. + | Some ([ attribElement ], namedArgs) -> + let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs + let msg = + match attribElement with + | ILAttribElem.String (Some msg) -> msg + | ILAttribElem.String None + | _ -> "" + + WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m)) + | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], namedArgs) -> + let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs + if isError then + if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then + CheckCompilerFeatureRequiredAttribute g cattrs msg m + else + ErrorD (ObsoleteDiagnostic(true, diagnosticId, msg, urlFormat, m)) + else + WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m)) + // Only DiagnosticId, UrlFormat + | Some (_, namedArgs) -> + let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs + WarnD(ObsoleteDiagnostic(false, diagnosticId, "", urlFormat, m)) + // No arguments + | None -> CompleteD /// Check IL attributes for 'ObsoleteAttribute', returning errors and warnings as data let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = - let (AttribInfo(tref,_)) = g.attrib_SystemObsolete - match TryDecodeILAttribute tref cattrs with - | Some ([ILAttribElem.String (Some msg) ], _) when not isByrefLikeTyconRef -> - WarnD(ObsoleteWarning(msg, m)) - | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], _) when not isByrefLikeTyconRef -> - if isError then - if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then - CheckCompilerFeatureRequiredAttribute g cattrs msg m - else - ErrorD (ObsoleteError(msg, m)) - else - WarnD (ObsoleteWarning(msg, m)) - | Some ([ILAttribElem.String None ], _) when not isByrefLikeTyconRef -> - WarnD(ObsoleteWarning("", m)) - | Some _ when not isByrefLikeTyconRef -> - WarnD(ObsoleteWarning("", m)) - | _ -> - CompleteD + trackErrors { + do! CheckILObsoleteAttributes g isByrefLikeTyconRef cattrs m + } let langVersionPrefix = "--langversion:preview" +let private extractObsoleteAttributeInfo namedArgs = + let extractILAttribValueFrom name namedArgs = + match namedArgs with + | ExtractAttribNamedArg name (AttribStringArg v) -> v + | _ -> "" + let diagnosticId = extractILAttribValueFrom "DiagnosticId" namedArgs + let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs + (diagnosticId, urlFormat) + +let private CheckObsoleteAttributes g attribs m = + trackErrors { + match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // [] + // Constructors deciding on IsError and Message properties. + | Some(Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) -> + let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs + do! WarnD(ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m)) + | Some(Attrib(unnamedArgs= [ AttribStringArg s; AttribBoolArg(isError) ]; propVal= namedArgs)) -> + let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs + if isError then + do! ErrorD (ObsoleteDiagnostic(true, diagnosticId, s, urlFormat, m)) + else + do! WarnD (ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m)) + // Only DiagnosticId, UrlFormat + | Some(Attrib(propVal= namedArgs)) -> + let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs + do! WarnD(ObsoleteDiagnostic(false, diagnosticId, "", urlFormat, m)) + | None -> () + } + +let private CheckCompilerMessageAttribute g attribs m = + trackErrors { + match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with + | Some(Attrib(unnamedArgs= [ AttribStringArg s ; AttribInt32Arg n ]; propVal= namedArgs)) -> + let msg = UserCompilerMessage(s, n, m) + let isError = + match namedArgs with + | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v + | _ -> false + // If we are using a compiler that supports nameof then error 3501 is always suppressed. + // See attribute on FSharp.Core 'nameof' + if n = 3501 then + () + elif isError && (not g.compilingFSharpCore || n <> 1204) then + do! ErrorD msg + else + do! WarnD msg + | _ -> + () + } + +let private CheckExperimentalAttribute g attribs m = + trackErrors { + match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with + | Some(Attrib(unnamedArgs= [ AttribStringArg(s) ])) -> + let isExperimentalAttributeDisabled (s:string) = + if g.compilingFSharpCore then + true + else + g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) + if not (isExperimentalAttributeDisabled s) then + do! WarnD(Experimental(s, m)) + | Some _ -> + do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) + | _ -> + () + } + +let private CheckUnverifiableAttribute g attribs m = + trackErrors { + match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with + | Some _ -> + do! WarnD(PossibleUnverifiableCode(m)) + | _ -> () + } + /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute', /// returning errors and warnings as data let CheckFSharpAttributes (g:TcGlobals) attribs m = if isNil attribs then CompleteD else trackErrors { - match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> - do! WarnD(ObsoleteWarning(s, m)) - | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> - if isError then - do! ErrorD (ObsoleteError(s, m)) - else - do! WarnD (ObsoleteWarning(s, m)) - | Some _ -> - do! WarnD(ObsoleteWarning("", m)) - | None -> - () - - match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> - let msg = UserCompilerMessage(s, n, m) - let isError = - match namedArgs with - | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v - | _ -> false - // If we are using a compiler that supports nameof then error 3501 is always suppressed. - // See attribute on FSharp.Core 'nameof' - if n = 3501 then - () - elif isError && (not g.compilingFSharpCore || n <> 1204) then - do! ErrorD msg - else - do! WarnD msg - | _ -> - () - - match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> - let isExperimentalAttributeDisabled (s:string) = - if g.compilingFSharpCore then - true - else - g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) - if not (isExperimentalAttributeDisabled s) then - do! WarnD(Experimental(s, m)) - | Some _ -> - do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) - | _ -> - () - - match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with - | Some _ -> - do! WarnD(PossibleUnverifiableCode(m)) - | _ -> - () + do! CheckObsoleteAttributes g attribs m + do! CheckCompilerMessageAttribute g attribs m + do! CheckExperimentalAttribute g attribs m + do! CheckUnverifiableAttribute g attribs m } #if !NO_TYPEPROVIDERS @@ -332,16 +408,16 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted) = let (AttribInfo(tref, _)) = g.attrib_SystemObsolete match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), tref.FullName)), m) with - | Some ([ Some (:? string as msg) ], _) -> WarnD(ObsoleteWarning(msg, m)) + | Some ([ Some (:? string as msg) ], _) -> WarnD(ObsoleteDiagnostic(false, "", msg, "", m)) | Some ([ Some (:? string as msg); Some (:?bool as isError) ], _) -> if isError then - ErrorD (ObsoleteError(msg, m)) + ErrorD (ObsoleteDiagnostic(true, "", msg, "", m)) else - WarnD (ObsoleteWarning(msg, m)) + WarnD (ObsoleteDiagnostic(false, "", msg, "", m)) | Some ([ None ], _) -> - WarnD(ObsoleteWarning("", m)) + WarnD(ObsoleteDiagnostic(false, "", "", "", m)) | Some _ -> - WarnD(ObsoleteWarning("", m)) + WarnD(ObsoleteDiagnostic(false, "", "", "", m)) | None -> CompleteD #endif diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 663198f9247..5885c1b39e9 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -13,9 +13,12 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree -exception ObsoleteWarning of string * range - -exception ObsoleteError of string * range +exception ObsoleteDiagnostic of + isError: bool * + diagnosticId: string * + message: string * + urlFormat: string * + range: range type AttribInfo = | FSAttribInfo of TcGlobals * Attrib diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 645f43fe3cb..e8d6f5a5af0 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -551,7 +551,7 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty = if isLessAccessible tyconAcc valAcc then let errorText = FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())) |> snd let warningText = errorText + Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime() - warning(AttributeChecking.ObsoleteWarning(warningText, m)) + warning(AttributeChecking.ObsoleteDiagnostic(false, "", warningText, "", m)) CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 9dcf0b72ea3..019226f46e4 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -148,8 +148,7 @@ type Exception with | IntfImplInExtrinsicAugmentation m | ValueRestriction(_, _, _, _, m) | LetRecUnsound(_, _, m) - | ObsoleteError(_, m) - | ObsoleteWarning(_, m) + | ObsoleteDiagnostic(_, _, _, _, m) | Experimental(_, m) | PossibleUnverifiableCode m | UserCompilerMessage(_, _, m) @@ -266,7 +265,7 @@ type Exception with | UnresolvedOverloading _ -> 41 | LibraryUseOnly _ -> 42 | ErrorFromAddingConstraint _ -> 43 - | ObsoleteWarning _ -> 44 + | ObsoleteDiagnostic(isError = false) -> 44 | ReservedKeyword _ -> 46 | SelfRefObjCtor _ -> 47 | VirtualAugmentationOnNullValuedType _ -> 48 @@ -327,7 +326,7 @@ type Exception with | UnresolvedConversionOperator _ -> 93 // avoid 94-100 for safety - | ObsoleteError _ -> 101 + | ObsoleteDiagnostic(isError = true) -> 101 #if !NO_TYPEPROVIDERS | TypeProviders.ProvidedTypeResolutionNoRange _ | TypeProviders.ProvidedTypeResolution _ -> 103 @@ -1790,9 +1789,7 @@ type Exception with | ValNotLocal _ -> os.AppendString(ValNotLocalE().Format) - | ObsoleteError(s, _) - - | ObsoleteWarning(s, _) -> + | ObsoleteDiagnostic(message = s) -> os.AppendString(Obsolete1E().Format) if s <> "" then diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 8cb0e76548d..75ddfba7382 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1789,6 +1789,7 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation" 3872,tcPartialActivePattern,"Multi-case partial active patterns are not supported. Consider using a single-case partial active pattern or a full active pattern." featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns" 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'" +3874,tcExpectedTypeParamMarkedWithUnitOfMeasureAttribute,"Expected unit-of-measure type parameter must be marked with the [] attribute." featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters" featureUseBangBindingValueDiscard,"Use 'use!' binding for value discard" diff --git a/src/Compiler/Service/BackgroundCompiler.fs b/src/Compiler/Service/BackgroundCompiler.fs index 63d147d005b..8f119f2fd60 100644 --- a/src/Compiler/Service/BackgroundCompiler.fs +++ b/src/Compiler/Service/BackgroundCompiler.fs @@ -1066,7 +1066,7 @@ type internal BackgroundCompiler tcProj.TcGlobals, options.IsIncompleteTypeCheckEnvironment, Some builder, - options, + Some options, Array.ofList tcDependencyFiles, creationDiags, parseResults.Diagnostics, @@ -1248,7 +1248,7 @@ type internal BackgroundCompiler tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcDependencyFiles, - options) + Some options) let results = FSharpCheckProjectResults( diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1c7878c6df8..0d6e83a61c2 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -348,7 +348,7 @@ type internal TypeCheckInfo tcAccessRights: AccessorDomain, projectFileName: string, mainInputFileName: string, - projectOptions: FSharpProjectOptions, + projectOptions: FSharpProjectOptions option, sResolutions: TcResolutions, sSymbolUses: TcSymbolUses, sFallback: NameResolutionEnv, @@ -3289,7 +3289,7 @@ module internal ParseAndCheckFile = tcEnvAtEnd.AccessRights, projectFileName, mainInputFileName, - projectOptions, + Some projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, @@ -3302,9 +3302,14 @@ module internal ParseAndCheckFile = } [] -type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions) = +type FSharpProjectContext + (thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions option) = - member _.ProjectOptions = projectOptions + // TODO: Once API around Transparent Compiler is stabilized we should probably remove this. + member _.ProjectOptions = + projectOptions + |> Option.defaultWith (fun () -> + failwith "ProjectOptions are not available. This is expected when using FSharpChecker with useTransparentCompiler=true.") member _.GetReferencedAssemblies() = assemblies @@ -3713,7 +3718,7 @@ type FSharpCheckProjectResults AccessorDomain * CheckedImplFile list option * string[] * - FSharpProjectOptions) option + FSharpProjectOptions option) option ) = let getDetails () = @@ -4009,7 +4014,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, - projectOptions) + Some projectOptions) let projectResults = FSharpCheckProjectResults(fileName, Some tcConfig, keepAssemblyContents, errors, Some details) diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 6b0a7f49135..607232f3c92 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -454,7 +454,7 @@ type public FSharpCheckFileResults = tcGlobals: TcGlobals * isIncompleteTypeCheckEnvironment: bool * builder: IncrementalBuilder option * - projectOptions: FSharpProjectOptions * + projectOptions: FSharpProjectOptions option * dependencyFiles: string[] * creationErrors: FSharpDiagnostic[] * parseErrors: FSharpDiagnostic[] * @@ -554,7 +554,7 @@ type public FSharpCheckProjectResults = AccessorDomain * CheckedImplFile list option * string[] * - FSharpProjectOptions) option -> + FSharpProjectOptions option) option -> FSharpCheckProjectResults module internal ParseAndCheckFile = diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index f25b75fe99d..9f35b4f2835 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1696,7 +1696,7 @@ type internal TransparentCompiler bootstrapInfo.TcGlobals, projectSnapshot.IsIncompleteTypeCheckEnvironment, None, - projectSnapshot.ToOptions(), + None, Array.ofList tcInfo.tcDependencyFiles, creationDiags, parseResults.Diagnostics, @@ -1963,7 +1963,7 @@ type internal TransparentCompiler tcEnvAtEnd.AccessRights, Some checkedImplFiles, Array.ofList tcDependencyFiles, - projectSnapshot.ToOptions()) + None) let results = FSharpCheckProjectResults( diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 31ec0536c3e..581b51ab8c7 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -9,6 +9,7 @@ namespace FSharp.Compiler.Diagnostics open System +open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckExpressions open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.SignatureConformance @@ -18,7 +19,6 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open Internal.Utilities.Library -open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler @@ -67,6 +67,17 @@ module ExtendedData = [] type IFSharpDiagnosticExtendedData = interface end + /// Additional data for diagnostics about obsolete attributes. + [] + type ObsoleteDiagnosticExtendedData + internal (diagnosticId: string, urlFormat: string) = + interface IFSharpDiagnosticExtendedData + /// Represents the DiagnosticId of the diagnostic + member this.DiagnosticId: string = diagnosticId + + /// Represents the URL format of the diagnostic + member this.UrlFormat: string = urlFormat + [] type TypeMismatchDiagnosticExtendedData internal (symbolEnv: SymbolEnv, dispEnv: DisplayEnv, expectedType: TType, actualType: TType, context: DiagnosticContextInfo) = @@ -201,6 +212,8 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str | DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(implTycon = implTycon; sigTycon = sigTycon) -> Some(DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData(sigTycon, implTycon)) + | ObsoleteDiagnostic(diagnosticId= diagnosticId; urlFormat= urlFormat) -> + Some(ObsoleteDiagnosticExtendedData(diagnosticId, urlFormat)) | _ -> None let msg = diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fsi b/src/Compiler/Symbols/FSharpDiagnostic.fsi index 6c941bdd84d..ecee4c0540b 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fsi +++ b/src/Compiler/Symbols/FSharpDiagnostic.fsi @@ -50,6 +50,17 @@ module public ExtendedData = interface end + /// Additional data for diagnostics about obsolete attributes. + [] + type public ObsoleteDiagnosticExtendedData = + interface IFSharpDiagnosticExtendedData + + /// Represents the DiagnosticId of the diagnostic + member DiagnosticId: string + + /// Represents the URL format of the diagnostic + member UrlFormat: string + /// Additional data for type-mismatch-like (usually with ErrorNumber = 1) diagnostics [] type public TypeMismatchDiagnosticExtendedData = diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 36823f65dc0..470327f59cd 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -1596,6 +1596,11 @@ type FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = | TyparConstraint.IsDelegate(ty1, ty2, _) -> FSharpGenericParameterDelegateConstraint(cenv, ty1, ty2) | _ -> invalidOp "not a delegate constraint" + member _.IsAllowsRefStructConstraint = + match cx with + | TyparConstraint.AllowsRefStruct _ -> true + | _ -> false + override x.ToString() = "" type FSharpInlineAnnotation = diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi index 5c26d2d42ea..49742673d58 100644 --- a/src/Compiler/Symbols/Symbols.fsi +++ b/src/Compiler/Symbols/Symbols.fsi @@ -708,6 +708,9 @@ type FSharpGenericParameterConstraint = /// Indicates a constraint that a type has a 'null' value member IsSupportsNullConstraint: bool + /// Indicates a constraint that a type doesn't support nullness + member IsNotSupportsNullConstraint: bool + /// Indicates a constraint that a type supports F# generic comparison member IsComparisonConstraint: bool @@ -750,6 +753,9 @@ type FSharpGenericParameterConstraint = /// Gets further information about a delegate constraint member DelegateConstraintData: FSharpGenericParameterDelegateConstraint + /// An anti-constraint indicating that ref structs (e.g. Span<>) are allowed here + member IsAllowsRefStructConstraint: bool + [] type FSharpInlineAnnotation = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e2bc362c784..d4f58881b19 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -243,6 +243,9 @@ and remapMeasureAux tyenv unt = | Some tpTy -> match tpTy with | TType_measure unt -> unt + | TType_var(typar= typar) when tp.Kind = TyparKind.Measure -> + // This is a measure typar that is not yet solved, so we can't remap it + error(Error(FSComp.SR.tcExpectedTypeParamMarkedWithUnitOfMeasureAttribute(), typar.Range)) | _ -> failwith "remapMeasureAux: incorrect kinds" | None -> unt | Some (TType_measure unt) -> remapMeasureAux tyenv unt @@ -3524,6 +3527,10 @@ let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = [] let (|ExtractAttribNamedArg|_|) nm args = args |> List.tryPick (function AttribNamedArg(nm2, _, _, v) when nm = nm2 -> Some v | _ -> None) |> ValueOptionInternal.ofOption + +[] +let (|ExtractILAttributeNamedArg|_|) nm (args: ILAttributeNamedArg list) = + args |> List.tryPick (function nm2, _, _, v when nm = nm2 -> Some v | _ -> None) |> ValueOptionInternal.ofOption [] let (|StringExpr|_|) = function Expr.Const (Const.String n, _, _) -> ValueSome n | _ -> ValueNone @@ -3540,6 +3547,8 @@ let (|AttribBoolArg|_|) = function AttribExpr(_, Expr.Const (Const.Bool n, _, _) [] let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _, _)) -> ValueSome n | _ -> ValueNone +let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None + let TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = match TryFindFSharpAttribute g nm attrs with | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 10f66bf63bf..3bca5cdb21e 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2601,6 +2601,9 @@ val (|ConstToILFieldInit|_|): Const -> ILFieldInit voption [] val (|ExtractAttribNamedArg|_|): string -> AttribNamedArg list -> AttribExpr voption +[] +val (|ExtractILAttributeNamedArg|_|): string -> ILAttributeNamedArg list -> ILAttribElem voption + [] val (|AttribInt32Arg|_|): (AttribExpr -> int32 voption) @@ -2613,6 +2616,8 @@ val (|AttribBoolArg|_|): (AttribExpr -> bool voption) [] val (|AttribStringArg|_|): (AttribExpr -> string voption) +val (|AttribElemStringArg|_|): (ILAttribElem -> string option) + [] val (|Int32Expr|_|): Expr -> int32 voption diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index d0dd8088d0d..cc5e0129f32 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. Syntaxe expr1[expr2] se používá pro indexování. Pokud chcete povolit indexování, zvažte možnost přidat anotaci typu, nebo pokud voláte funkci, přidejte mezeru, třeba expr1 [expr2]. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 1e8cfe71fea..20e20cf70b9 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. Die Syntax "expr1[expr2]" wird für die Indizierung verwendet. Fügen Sie ggf. eine Typanmerkung hinzu, um die Indizierung zu aktivieren, oder fügen Sie beim Aufrufen einer Funktion ein Leerzeichen hinzu, z. B. "expr1 [expr2]". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 3124b130426..530d664bf39 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. La sintaxis "expr1[expr2]" se usa para la indexación. Considere la posibilidad de agregar una anotación de tipo para habilitar la indexación, si se llama a una función, agregue un espacio, por ejemplo, "expr1 [expr2]". diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 98442392f67..7abad9be212 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. La syntaxe « expr1[expr2] » est utilisée pour l’indexation. Envisagez d’ajouter une annotation de type pour activer l’indexation, ou si vous appelez une fonction, ajoutez un espace, par exemple « expr1 [expr2] ». diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 0ad02dcab33..573943ab292 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. La sintassi 'expr1[expr2]' viene usata per l'indicizzazione. Provare ad aggiungere un'annotazione di tipo per abilitare l'indicizzazione oppure se la chiamata a una funzione aggiunge uno spazio, ad esempio 'expr1 [expr2]'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 76014c5f081..5f5414025a0 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. 構文 'expr1[expr2]' はインデックス作成に使用されます。インデックスを有効にするために型の注釈を追加するか、関数を呼び出す場合には、'expr1 [expr2]' のようにスペースを入れます。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 26519b8c7a3..6b5922783b6 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. 인덱싱에는 'expr1[expr2]' 구문이 사용됩니다. 인덱싱을 사용하도록 설정하기 위해 형식 주석을 추가하는 것을 고려하거나 함수를 호출하는 경우 공백을 추가하세요(예: 'expr1 [expr2]'). diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 0d80733a2dc..2048f0b47c3 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. Do indeksowania używana jest składnia „expr1[expr2]”. Rozważ dodanie adnotacji typu, aby umożliwić indeksowanie, lub jeśli wywołujesz funkcję dodaj spację, np. „expr1 [expr2]”. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index edb38fc356a..70fd0f1b333 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. A sintaxe 'expr1[expr2]' é usada para indexação. Considere adicionar uma anotação de tipo para habilitar a indexação ou, se chamar uma função, adicione um espaço, por exemplo, 'expr1 [expr2]'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 6e54d232187..564d99f2835 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. Для индексирования используется синтаксис "expr1[expr2]". Рассмотрите возможность добавления аннотации типа для включения индексации или при вызове функции добавьте пробел, например "expr1 [expr2]". diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 2df10343769..77c8cdd9948 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. Söz dizimi “expr1[expr2]” dizin oluşturma için kullanılıyor. Dizin oluşturmayı etkinleştirmek için bir tür ek açıklama eklemeyi düşünün veya bir işlev çağırıyorsanız bir boşluk ekleyin, örn. “expr1 [expr2]”. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index eb03cbcaac8..4f13728960d 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. 语法“expr1[expr2]”用于索引。考虑添加类型批注来启用索引，或者在调用函数添加空格，例如“expr1 [expr2]”。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index f8820624484..5da35fdf95a 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -1367,6 +1367,11 @@ An empty body may only be used if the computation expression builder defines a 'Zero' method. + + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute. + + The syntax 'expr1[expr2]' is used for indexing. Consider adding a type annotation to enable indexing, or if calling a function add a space, e.g. 'expr1 [expr2]'. 語法 'expr1[expr2]' 已用於編製索引。請考慮新增類型註釋來啟用編製索引，或是呼叫函式並新增空格，例如 'expr1 [expr2]'。 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs index 65a1cceb43d..23e4a9b9440 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/ExtendedDiagnosticDataTests.fs @@ -241,3 +241,304 @@ type Foo = {| bar: int; x: int |} (fun (fieldsData: DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData) -> assertRange (4,5) (4,8) fieldsData.SignatureRange assertRange (4,6) (4,9) fieldsData.ImplementationRange) + + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 01`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 02`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 03`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 04`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) + + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 05`` () = + let CSLib = + CSharp """ +using System; +[Obsolete("Use something else", false, DiagnosticId = "FS222")] +public static class Class1 +{ + public static string Test() + { + return "Hello"; + } +} + """ + |> withName "CSLib" + + let app = + FSharp """ +open MyLib + +let text = Class1.Test(); + """ |> withReferences [CSLib] + + app + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Use something else") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 06`` () = + let CSLib = + CSharp """ +using System; +[Obsolete("Use something else", false, DiagnosticId = "FS222", UrlFormat = "https://example.com")] +public static class Class1 +{ + public static string Test() + { + return "Hello"; + } +} + """ + |> withName "CSLib" + + let app = + FSharp """ +open MyLib + +let text = Class1.Test(); + """ |> withReferences [CSLib] + + app + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Use something else") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 07`` () = + let CSLib = + CSharp """ +using System; +[Obsolete("Use something else", false)] +public static class Class1 +{ + public static string Test() + { + return "Hello"; + } +} + """ + |> withName "CSLib" + + let app = + FSharp """ +open MyLib + +let text = Class1.Test(); + """ |> withReferences [CSLib] + + app + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated. Use something else") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 08`` () = + let CSLib = + CSharp """ +using System; +[Obsolete(DiagnosticId = "FS222", UrlFormat = "https://example.com")] +public static class Class1 +{ + public static string Test() + { + return "Hello"; + } +} + """ + |> withName "CSLib" + + let app = + FSharp """ +open MyLib + +let text = Class1.Test(); + """ |> withReferences [CSLib] + + app + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 09`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Warning - ObsoleteDiagnosticExtendedData 10`` () = + let CSLib = + CSharp """ +using System; +[Obsolete] +public static class Class1 +{ + public static string Test() + { + return "Hello"; + } +} + """ + |> withName "CSLib" + + let app = + FSharp """ +open MyLib + +let text = Class1.Test(); + """ |> withReferences [CSLib] + + app + |> typecheckResults + |> checkDiagnostic + (44, "This construct is deprecated") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Error - ObsoleteDiagnosticExtendedData 01`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (101, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Error - ObsoleteDiagnosticExtendedData 02`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (101, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Error - ObsoleteDiagnosticExtendedData 03`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (101, "This construct is deprecated. Message") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("", obsoleteDiagnostic.UrlFormat)) + +[] +let ``Error - ObsoleteDiagnosticExtendedData 04`` () = + FSharp """ +open System +[] +type MyClass() = class end + +let x = MyClass() +""" + |> typecheckResults + |> checkDiagnostic + (101, "This construct is deprecated") + (fun (obsoleteDiagnostic: ObsoleteDiagnosticExtendedData) -> + Assert.Equal("FS222", obsoleteDiagnostic.DiagnosticId) + Assert.Equal("https://example.com", obsoleteDiagnostic.UrlFormat)) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnitOfMeasureTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnitOfMeasureTests.fs new file mode 100644 index 00000000000..36ef76e772d --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnitOfMeasureTests.fs @@ -0,0 +1,52 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module ErrorMessages.UnitOfMeasureTests + +open Xunit +open FSharp.Test.Compiler + +[] +let ``Error - Expected unit-of-measure type parameter must be marked with the [] attribute.`` () = + Fsx """ +type A<[]'u>(x : int<'u>) = + member this.X = x + +type B<'u>(x: 'u) = + member this.X = x + +module M = + type A<'u> with // Note the missing Measure attribute + member this.Y = this.X + + type B<'u> with + member this.Y = this.X + +open System.Runtime.CompilerServices +type FooExt = + [] + static member Bar(this: A<'u>, value: A<'u>) = this + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 3874, Line 9, Col 12, Line 9, Col 14, "Expected unit-of-measure type parameter must be marked with the [] attribute.") + ] + +[] +let ``Expected unit-of-measure type parameter must be marked with the [] attribute.`` () = + Fsx """ +type A<[]'u>(x : int<'u>) = + member this.X = x + +module M = + type A<[] 'u> with // Note the Measure attribute + member this.Y = this.X + +open System.Runtime.CompilerServices +type FooExt = + [] + static member Bar(this: A<'u>, value: A<'u>) = this + """ + |> typecheck + |> shouldSucceed + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index b96aba6777b..9eb31c35e0d 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -218,6 +218,7 @@ + diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 6004f3fb62d..e85b3022c96 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -2856,6 +2856,11 @@ FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedDa FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+IFSharpDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String get_UrlFormat() +FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity get_Severity() @@ -5398,6 +5403,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsRequiresDefa FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSimpleChoiceConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSupportsNullConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsUnmanagedConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsNotSupportsNullConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsAllowsRefStructConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsCoercesToConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsComparisonConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsDefaultsToConstraint() @@ -5411,6 +5418,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsRequires FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSimpleChoiceConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSupportsNullConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsUnmanagedConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsNotSupportsNullConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsAllowsRefStructConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint DefaultsToConstraintData FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint get_DefaultsToConstraintData() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDelegateConstraint DelegateConstraintData diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 6004f3fb62d..e85b3022c96 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -2856,6 +2856,11 @@ FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedDa FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+IFSharpDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: System.String get_UrlFormat() +FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity get_Severity() @@ -5398,6 +5403,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsRequiresDefa FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSimpleChoiceConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSupportsNullConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsUnmanagedConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsNotSupportsNullConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsAllowsRefStructConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsCoercesToConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsComparisonConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsDefaultsToConstraint() @@ -5411,6 +5418,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsRequires FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSimpleChoiceConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSupportsNullConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsUnmanagedConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsNotSupportsNullConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsAllowsRefStructConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint DefaultsToConstraintData FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint get_DefaultsToConstraintData() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDelegateConstraint DelegateConstraintData diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl index 1a5e3d85c4a..81cc143b139 100644 --- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl +++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl @@ -40,7 +40,7 @@ [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-508::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-508::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-508::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack. -[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2490-1::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000015][found Char] Unexpected type on the stack. +[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2495-1::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000015][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.CreateILModule+MainModuleBuilder::ConvertProductVersionToILVersionInfo(string)][offset 0x00000011][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.StaticLinking+TypeForwarding::followTypeForwardForILTypeRef([FSharp.Compiler.Service]FSharp.Compiler.AbstractIL.IL+ILTypeRef)][offset 0x00000010][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.CompilerOptions::getCompilerOption([FSharp.Compiler.Service]FSharp.Compiler.CompilerOptions+CompilerOption, [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1)][offset 0x000000E6][found Char] Unexpected type on the stack. diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl index 77ba0d7133e..588f29f5a96 100644 --- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl +++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl @@ -39,7 +39,7 @@ [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-529::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000064][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-529::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000006D][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-529::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000076][found Char] Unexpected type on the stack. -[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2490-3::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000030][found Char] Unexpected type on the stack. +[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2495-3::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000030][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@301-1::Invoke(string)][offset 0x0000000B][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@301-1::Invoke(string)][offset 0x00000014][found Char] Unexpected type on the stack. [IL]: Error [StackUnexpected]: : FSharp.Compiler.CreateILModule+MainModuleBuilder::ConvertProductVersionToILVersionInfo(string)][offset 0x00000010][found Char] Unexpected type on the stack. diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs index 747455e271f..50dd53a55a4 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fs +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -613,7 +613,7 @@ type ProvidedTypeSymbol(kind: ProvidedTypeSymbolKind, typeArgs: Type list, typeB | ProvidedTypeSymbolKind.ByRef, [| arg |] -> arg.Name + "&" | ProvidedTypeSymbolKind.Generic gty, _typeArgs -> gty.Name | ProvidedTypeSymbolKind.FSharpTypeAbbreviation (_, _, path), _ -> path[path.Length-1] - | _ -> failwith "unreachable" + | c -> failwithf "unreachable %O" c override __.BaseType = match kind with @@ -669,7 +669,7 @@ type ProvidedTypeSymbol(kind: ProvidedTypeSymbolKind, typeArgs: Type list, typeB | ProvidedTypeSymbolKind.ByRef, [| arg |] -> 43904 + hash arg | ProvidedTypeSymbolKind.Generic gty, _ -> 9797 + hash gty + Array.sumBy hash typeArgs | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _, _ -> 3092 - | _ -> failwith "unreachable" + | c -> failwithf "unreachable %O" c override this.Equals(other: obj) = eqTypeObj this other @@ -1313,16 +1313,17 @@ and ProvidedMeasureBuilder() = // there seems to be no way to check if a type abbreviation exists static let unitNamesTypeAbbreviations = [ - "meter"; "hertz"; "newton"; "pascal"; "joule"; "watt"; "coulomb"; - "volt"; "farad"; "ohm"; "siemens"; "weber"; "tesla"; "henry" - "lumen"; "lux"; "becquerel"; "gray"; "sievert"; "katal" + "metre"; "meter"; "kilogram"; "second"; "ampere"; "kelvin"; "mole"; "candela" + "hertz"; "newton"; "pascal"; "joule"; "watt"; "coulomb"; "volt"; "farad" + "ohm"; "siemens"; "weber"; "tesla"; "henry"; "lumen"; "lux"; "becquerel" + "gray"; "sievert"; "katal" ] |> Set.ofList static let unitSymbolsTypeAbbreviations = [ "m"; "kg"; "s"; "A"; "K"; "mol"; "cd"; "Hz"; "N"; "Pa"; "J"; "W"; "C" - "V"; "F"; "S"; "Wb"; "T"; "lm"; "lx"; "Bq"; "Gy"; "Sv"; "kat"; "H" + "V"; "F"; "S"; "ohm"; "Wb"; "T"; "lm"; "lx"; "Bq"; "Gy"; "Sv"; "kat"; "H" ] |> Set.ofList @@ -1448,7 +1449,7 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri let save (key: BindingFlags) f : 'T = let key = int key - if bindings = null then + if isNull bindings then bindings <- Dictionary<_, _>(HashIdentity.Structural) if not (moreMembers()) && bindings.ContainsKey(key) then @@ -1557,13 +1558,13 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri (//save ("methods", bindingFlags, None) (fun () -> getMembers() |> Array.choose (function :? MethodInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) - |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetMethods(bindingFlags))))) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || isNull this.BaseType then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetMethods(bindingFlags))))) override this.GetFields bindingFlags = (//save ("fields", bindingFlags, None) (fun () -> getMembers() |> Array.choose (function :? FieldInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) - |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetFields(bindingFlags))))) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || isNull this.BaseType then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetFields(bindingFlags))))) override this.GetProperties bindingFlags = (//save ("props", bindingFlags, None) (fun () -> @@ -1571,7 +1572,7 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri getMembers() |> Array.choose (function :? PropertyInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) staticOrPublic - |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || isNull this.BaseType then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetProperties(bindingFlags))))) @@ -1579,13 +1580,13 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri (//save ("events", bindingFlags, None) (fun () -> getMembers() |> Array.choose (function :? EventInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) - |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetEvents(bindingFlags))))) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || isNull this.BaseType then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetEvents(bindingFlags))))) override __.GetNestedTypes bindingFlags = (//save ("nested", bindingFlags, None) (fun () -> getMembers() |> Array.choose (function :? Type as m when memberBinds true bindingFlags false m.IsPublic || m.IsNestedPublic -> Some m | _ -> None) - |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetNestedTypes(bindingFlags))))) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || isNull this.BaseType then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetNestedTypes(bindingFlags))))) override this.GetConstructorImpl(bindingFlags, _binder, _callConventions, _types, _modifiers) = let xs = this.GetConstructors bindingFlags |> Array.filter (fun m -> m.Name = ".ctor") @@ -1601,7 +1602,7 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri let methods = this.GetMethods bindingFlags methods |> Seq.groupBy (fun m -> m.Name) |> Seq.map (fun (k, v) -> k, Seq.toArray v) |> dict) - let xs = if table.ContainsKey name then table[name] else [| |] + let xs = match table.TryGetValue name with | true, tn -> tn | false, _ -> [| |] //let xs = this.GetMethods bindingFlags |> Array.filter (fun m -> m.Name = name) if xs.Length > 1 then failwithf "GetMethodImpl. not support overloads, name = '%s', methods - '%A', callstack = '%A'" name xs Environment.StackTrace if xs.Length > 0 then xs[0] else null) @@ -1617,7 +1618,7 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri save (bindingFlags ||| BindingFlags.GetProperty) (fun () -> let methods = this.GetProperties bindingFlags methods |> Seq.groupBy (fun m -> m.Name) |> Seq.map (fun (k, v) -> k, Seq.toArray v) |> dict) - let xs = if table.ContainsKey name then table[name] else [| |] + let xs = match table.TryGetValue name with | true, tn -> tn | false, _ -> [| |] //let xs = this.GetProperties bindingFlags |> Array.filter (fun m -> m.Name = name) if xs.Length > 0 then xs[0] else null) @@ -1804,7 +1805,7 @@ and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: stri match keylist with | [] -> () | key::rest -> - buckets[key] <- (rest, v) :: (if buckets.ContainsKey key then buckets[key] else []); + buckets.[key] <- (rest, v) :: (match buckets.TryGetValue key with |true, bucket -> bucket | false, _ -> []); [ for (KeyValue(key, items)) in buckets -> nodef key items ] @@ -2209,7 +2210,7 @@ module internal AssemblyReader = override x.ToString() = x.QualifiedName - type ILArrayBound = int32 option + type ILArrayBound = int32 uoption type ILArrayBounds = ILArrayBound * ILArrayBound [] @@ -2217,11 +2218,11 @@ module internal AssemblyReader = | ILArrayShape of ILArrayBounds[] (* lobound/size pairs *) member x.Rank = (let (ILArrayShape l) = x in l.Length) static member SingleDimensional = ILArrayShapeStatics.SingleDimensional - static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape(List.replicate n (Some 0, None) |> List.toArray) + static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape(List.replicate n (USome 0, UNone) |> List.toArray) and ILArrayShapeStatics() = - static let singleDimensional = ILArrayShape [| (Some 0, None) |] + static let singleDimensional = ILArrayShape [| (USome 0, UNone) |] static member SingleDimensional = singleDimensional /// Calling conventions. These are used in method pointer types. @@ -2259,6 +2260,7 @@ module internal AssemblyReader = static member Instance = instanceCallConv static member Static = staticCallConv + [] type ILBoxity = | AsObject | AsValue @@ -2360,9 +2362,9 @@ module internal AssemblyReader = | ILType.Array (ILArrayShape(s), ty) -> ty.BasicQualifiedName + "[" + System.String(',', s.Length-1) + "]" | ILType.Value tr | ILType.Boxed tr -> tr.BasicQualifiedName | ILType.Void -> "void" - | ILType.Ptr _ty -> failwith "unexpected pointer type" - | ILType.Byref _ty -> failwith "unexpected byref type" - | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" + | ILType.Ptr _ty -> failwithf "unexpected pointer type %O" _ty + | ILType.Byref _ty -> failwithf "unexpected byref type %O" _ty + | ILType.FunctionPointer _mref -> failwithf "unexpected function pointer type %O" _mref member x.QualifiedNameExtension = match x with @@ -2371,9 +2373,9 @@ module internal AssemblyReader = | ILType.Array (ILArrayShape(_s), ty) -> ty.QualifiedNameExtension | ILType.Value tr | ILType.Boxed tr -> tr.QualifiedNameExtension | ILType.Void -> failwith "void" - | ILType.Ptr _ty -> failwith "unexpected pointer type" - | ILType.Byref _ty -> failwith "unexpected byref type" - | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" + | ILType.Ptr _ty -> failwithf "unexpected pointer type %O" _ty + | ILType.Byref _ty -> failwithf "unexpected byref type %O" _ty + | ILType.FunctionPointer _mref -> failwithf "unexpected function pointer type %O" _mref member x.QualifiedName = x.BasicQualifiedName + x.QualifiedNameExtension @@ -2381,18 +2383,18 @@ module internal AssemblyReader = member x.TypeSpec = match x with | ILType.Boxed tr | ILType.Value tr -> tr - | _ -> failwithf "not a nominal type" + | c -> failwithf "not a nominal type %O" c member x.Boxity = match x with | ILType.Boxed _ -> AsObject | ILType.Value _ -> AsValue - | _ -> failwithf "not a nominal type" + | c -> failwithf "not a nominal type %O" c member x.TypeRef = match x with | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef - | _ -> failwithf "not a nominal type" + | c -> failwithf "not a nominal type %O" c member x.IsNominal = match x with @@ -2843,14 +2845,13 @@ module internal AssemblyReader = let mutable lmap = null let getmap() = - if lmap = null then + if isNull lmap then lmap <- Dictionary() for y in larr.Force() do let key = y.Name - if lmap.ContainsKey key then - lmap[key] <- Array.append [| y |] lmap[key] - else - lmap[key] <- [| y |] + match lmap.TryGetValue key with + | true, lmpak -> lmap.[key] <- Array.append [| y |] lmpak + | false, _ -> lmap.[key] <- [| y |] lmap member __.Entries = larr.Force() @@ -3061,7 +3062,7 @@ module internal AssemblyReader = let mutable lmap = null let getmap() = - if lmap = null then + if isNull lmap then lmap <- Dictionary() for (nsp, nm, ltd) in larr.Force() do let key = nsp, nm @@ -3074,9 +3075,10 @@ module internal AssemblyReader = member __.TryFindByName (nsp, nm) = let tdefs = getmap() let key = (nsp, nm) - if tdefs.ContainsKey key then - Some (tdefs[key].Force()) - else + match tdefs.TryGetValue key with + | true, tdefFal -> + Some (tdefFal.Force()) + | false, _ -> None type ILNestedExportedType = @@ -3105,7 +3107,7 @@ module internal AssemblyReader = and ILExportedTypesAndForwarders(larr:Lazy) = let mutable lmap = null let getmap() = - if lmap = null then + if isNull lmap then lmap <- Dictionary() for ltd in larr.Force() do let key = ltd.Namespace, ltd.Name @@ -4565,8 +4567,9 @@ module internal AssemblyReader = | null -> cache := new Dictionary<_, _>(11 (* sz:int *) ) | _ -> () !cache - if cache.ContainsKey idx then cache[idx] - else let res = f idx in cache[idx] <- res; res + match cache.TryGetValue idx with + | true, cached -> cached + | false, _ -> let res = f idx in cache.[idx] <- res; res let seekFindRow numRows rowChooser = let mutable i = 1 @@ -5108,18 +5111,18 @@ module internal AssemblyReader = seekReadIdx tableBigness[tab.Index] &addr - let seekReadResolutionScopeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> ResolutionScopeTag idx) 2 rsBigness &addr - let seekReadTypeDefOrRefOrSpecIdx (addr: byref) = seekReadTaggedIdx (fun idx -> TypeDefOrRefOrSpecTag idx) 2 tdorBigness &addr - let seekReadTypeOrMethodDefIdx (addr: byref) = seekReadTaggedIdx (fun idx -> TypeOrMethodDefTag idx) 1 tomdBigness &addr - let seekReadHasConstantIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasConstantTag idx) 2 hcBigness &addr - let seekReadHasCustomAttributeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasCustomAttributeTag idx) 5 hcaBigness &addr - //let seekReadHasFieldMarshalIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasFieldMarshalTag idx) 1 hfmBigness &addr - //let seekReadHasDeclSecurityIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasDeclSecurityTag idx) 2 hdsBigness &addr - let seekReadMemberRefParentIdx (addr: byref) = seekReadTaggedIdx (fun idx -> MemberRefParentTag idx) 3 mrpBigness &addr - let seekReadHasSemanticsIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasSemanticsTag idx) 1 hsBigness &addr - let seekReadMethodDefOrRefIdx (addr: byref) = seekReadTaggedIdx (fun idx -> MethodDefOrRefTag idx) 1 mdorBigness &addr - let seekReadImplementationIdx (addr: byref) = seekReadTaggedIdx (fun idx -> ImplementationTag idx) 2 iBigness &addr - let seekReadCustomAttributeTypeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> CustomAttributeTypeTag idx) 3 catBigness &addr + let seekReadResolutionScopeIdx (addr: byref) = seekReadTaggedIdx ResolutionScopeTag 2 rsBigness &addr + let seekReadTypeDefOrRefOrSpecIdx (addr: byref) = seekReadTaggedIdx TypeDefOrRefOrSpecTag 2 tdorBigness &addr + let seekReadTypeOrMethodDefIdx (addr: byref) = seekReadTaggedIdx TypeOrMethodDefTag 1 tomdBigness &addr + let seekReadHasConstantIdx (addr: byref) = seekReadTaggedIdx HasConstantTag 2 hcBigness &addr + let seekReadHasCustomAttributeIdx (addr: byref) = seekReadTaggedIdx HasCustomAttributeTag 5 hcaBigness &addr + //let seekReadHasFieldMarshalIdx (addr: byref) = seekReadTaggedIdx HasFieldMarshalTag 1 hfmBigness &addr + //let seekReadHasDeclSecurityIdx (addr: byref) = seekReadTaggedIdx HasDeclSecurityTag 2 hdsBigness &addr + let seekReadMemberRefParentIdx (addr: byref) = seekReadTaggedIdx MemberRefParentTag 3 mrpBigness &addr + let seekReadHasSemanticsIdx (addr: byref) = seekReadTaggedIdx HasSemanticsTag 1 hsBigness &addr + let seekReadMethodDefOrRefIdx (addr: byref) = seekReadTaggedIdx MethodDefOrRefTag 1 mdorBigness &addr + let seekReadImplementationIdx (addr: byref) = seekReadTaggedIdx ImplementationTag 2 iBigness &addr + let seekReadCustomAttributeTypeIdx (addr: byref) = seekReadTaggedIdx CustomAttributeTypeTag 3 catBigness &addr let seekReadStringIdx (addr: byref) = seekReadIdx stringsBigness &addr let seekReadGuidIdx (addr: byref) = seekReadIdx guidsBigness &addr let seekReadBlobIdx (addr: byref) = seekReadIdx blobsBigness &addr @@ -5692,7 +5695,7 @@ module internal AssemblyReader = | tag when tag = ImplementationTag.File -> ILScopeRef.Module (seekReadFile idx) | tag when tag = ImplementationTag.AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef idx) | tag when tag = ImplementationTag.ExportedType -> failwith "seekReadImplAsScopeRef" - | _ -> failwith "seekReadImplAsScopeRef" + | c -> failwithf "seekReadImplAsScopeRef %O" c and seekReadTypeRefScope (TaggedIndex(tag, idx) ): ILTypeRefScope = match tag with @@ -5700,7 +5703,7 @@ module internal AssemblyReader = | tag when tag = ResolutionScopeTag.ModuleRef -> ILTypeRefScope.Top(ILScopeRef.Module (seekReadModuleRef idx)) | tag when tag = ResolutionScopeTag.AssemblyRef -> ILTypeRefScope.Top(ILScopeRef.Assembly (seekReadAssemblyRef idx)) | tag when tag = ResolutionScopeTag.TypeRef -> ILTypeRefScope.Nested (seekReadTypeRef idx) - | _ -> failwith "seekReadTypeRefScope" + | c -> failwithf "seekReadTypeRefScope %O" c and seekReadOptionalTypeDefOrRef numtypars boxity idx = if idx = TaggedIndex(TypeDefOrRefOrSpecTag.TypeDef, 0) then None @@ -5808,8 +5811,8 @@ module internal AssemblyReader = let lobounds, sigptr = sigptrFold sigptrGetZInt32 numLoBounded bytes sigptr let shape = let dim i = - (if i < numLoBounded then Some lobounds[i] else None), - (if i < numSized then Some sizes[i] else None) + (if i < numLoBounded then USome lobounds[i] else UNone), + (if i < numSized then USome sizes[i] else UNone) ILArrayShape (Array.init rank dim) ILType.Array (shape, typ), sigptr @@ -6420,7 +6423,7 @@ module internal AssemblyReader = | :? Type as ty -> encodeCustomAttrString ty.FullName | :? (obj[]) as elems -> [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue elem |] - | _ -> failwith "unexpected value in custom attribute" + | c -> failwithf "unexpected value in custom attribute (%O)" c and encodeCustomAttrValue ty (c: obj) = match ty, c with @@ -6561,7 +6564,7 @@ module internal AssemblyReader = step() drop() - Some(ILArrayShape(Array.create rank (Some 0, None))) + Some(ILArrayShape(Array.create rank (USome 0, UNone))) else None @@ -6688,7 +6691,7 @@ module internal AssemblyReader = (argty, box (char n)), sigptr | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Boolean" -> let n, sigptr = sigptr_get_byte bytes sigptr - (argty, box (not (n = 0))), sigptr + (argty, box (n <> 0)), sigptr | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "String" -> //printfn "parsing string, sigptr = %d" sigptr let n, sigptr = sigptr_get_serstring_possibly_null bytes sigptr @@ -6805,7 +6808,7 @@ module internal AssemblyReader = // Auto-clear the cache every 30.0 seconds. // We would use System.Runtime.Caching but some version constraints make this difficult. - let enableAutoClear = try Environment.GetEnvironmentVariable("FSHARP_TPREADER_AUTOCLEAR_OFF") = null with _ -> true + let enableAutoClear = try isNull (Environment.GetEnvironmentVariable "FSHARP_TPREADER_AUTOCLEAR_OFF") with _ -> true let clearSpanDefault = 30000 let clearSpan = try (match Environment.GetEnvironmentVariable("FSHARP_TPREADER_AUTOCLEAR_SPAN") with null -> clearSpanDefault | s -> int32 s) with _ -> clearSpanDefault let lastAccessLock = obj() @@ -6954,9 +6957,9 @@ namespace ProviderImplementation.ProvidedTypes type TxTable<'T2>() = let tab = Dictionary() member __.Get inp f = - if tab.ContainsKey inp then - tab[inp] - else + match tab.TryGetValue inp with + | true, tabVal -> tabVal + | false, _ -> let res = f() tab[inp] <- res res @@ -7525,7 +7528,7 @@ namespace ProviderImplementation.ProvidedTypes // See bug https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/236 override __.IsSZArray = match kind with - | TypeSymbolKind.SDArray _ -> true + | TypeSymbolKind.SDArray -> true | _ -> false #endif override this.GetMember(_name, _mt, _bindingFlags) = notRequired this "GetMember" this.Name @@ -8028,7 +8031,7 @@ namespace ProviderImplementation.ProvidedTypes override __.GetEnumUnderlyingType() = if this.IsEnum then txILType ([| |], [| |]) ilGlobals.typ_Int32 // TODO: in theory the assumption of "Int32" is not accurate for all enums, however in practice .NET only uses enums with backing field Int32 - else failwithf "not enum type" + else failwithf "not enum type %O" this override __.IsArrayImpl() = false override __.IsByRefImpl() = false @@ -8099,6 +8102,9 @@ namespace ProviderImplementation.ProvidedTypes txTable.Get inp.Token (fun () -> // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. + // See convertConstExpr in the compiler, e.g. + // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // for the accepted types. match inp.Namespace, inp.Name with //| USome "System", "Void"-> typeof (* @@ -8987,7 +8993,7 @@ namespace ProviderImplementation.ProvidedTypes if i < 0 then let msg = if toTgt then sprintf "The design-time type '%O' utilized by a type provider was not found in the target reference assembly set '%A'. You may be referencing a profile which contains fewer types than those needed by the type provider you are using." t (getTargetAssemblies() |> Seq.toList) - elif getSourceAssemblies() |> Seq.length = 0 then sprintf "A failure occurred while determining compilation references" + elif getSourceAssemblies() |> Seq.isEmpty then sprintf "A failure occurred while determining compilation references" else sprintf "The target type '%O' utilized by a type provider was not found in the design-time assembly set '%A'. Please report this problem to the project site for the type provider." t (getSourceAssemblies() |> Seq.toList) failwith msg else @@ -9552,10 +9558,10 @@ namespace ProviderImplementation.ProvidedTypes /// Check that the data held at a fixup is some special magic value, as a sanity check /// to ensure the fixup is being placed at a ood location. let checkFixup32 (data: byte[]) offset exp = - if data[offset + 3] <> b3 exp then failwith "fixup sanity check failed" - if data[offset + 2] <> b2 exp then failwith "fixup sanity check failed" - if data[offset + 1] <> b1 exp then failwith "fixup sanity check failed" - if data[offset] <> b0 exp then failwith "fixup sanity check failed" + if data.[offset + 3] <> b3 exp then failwithf "fixup sanity check failed at %O" offset + if data.[offset + 2] <> b2 exp then failwithf "fixup sanity check failed at %O" offset + if data.[offset + 1] <> b1 exp then failwithf "fixup sanity check failed at %O" offset + if data.[offset] <> b0 exp then failwithf "fixup sanity check failed at %O" offset let applyFixup32 (data:byte[]) offset v = data[offset] <- b0 v @@ -9983,9 +9989,9 @@ namespace ProviderImplementation.ProvidedTypes let splitNameAt (nm:string) idx = - if idx < 0 then failwith "splitNameAt: idx < 0"; + if idx < 0 then failwithf "splitNameAt: idx < 0: %O" idx; let last = nm.Length - 1 - if idx > last then failwith "splitNameAt: idx > last"; + if idx > last then failwithf "splitNameAt: idx > last: %O %O" idx last; (nm.Substring(0, idx)), (if idx < last then nm.Substring (idx+1, last - idx) else "") @@ -10157,13 +10163,13 @@ namespace ProviderImplementation.ProvidedTypes // REVIEW: write into an accumulating buffer let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) = - let sized = Array.filter (function (_, Some _) -> true | _ -> false) shape - let lobounded = Array.filter (function (Some _, _) -> true | _ -> false) shape + let sized = Array.filter (function (_, USome _) -> true | _ -> false) shape + let lobounded = Array.filter (function (USome _, _) -> true | _ -> false) shape bb.EmitZ32 shape.Length bb.EmitZ32 sized.Length - sized |> Array.iter (function (_, Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") + sized |> Array.iter (function (_, USome sz) -> bb.EmitZ32 sz | c -> failwithf "%O ?" c) bb.EmitZ32 lobounded.Length - lobounded |> Array.iter (function (Some low, _) -> bb.EmitZ32 low | _ -> failwith "?") + lobounded |> Array.iter (function (USome low, _) -> bb.EmitZ32 low | c -> failwithf "%O ?" c) let hasthisToByte hasthis = match hasthis with @@ -10672,8 +10678,8 @@ namespace ProviderImplementation.ProvidedTypes | _ -> () UnsharedRow - [| HasCustomAttribute (fst hca, snd hca) - CustomAttributeType (fst cat, snd cat) + [| HasCustomAttribute hca + CustomAttributeType cat Blob (GetCustomAttrDataAsBlobIdx cenv attr.Data) |] @@ -10937,8 +10943,9 @@ namespace ProviderImplementation.ProvidedTypes if not (origAvailBrFixups.ContainsKey tg) then printfn "%s" ("branch target " + formatCodeLabel tg + " not found in code") let origDest = - if origAvailBrFixups.ContainsKey tg then origAvailBrFixups[tg] - else 666666 + match origAvailBrFixups.TryGetValue tg with + | true, oaVal -> oaVal + | false, _ -> 666666 let origRelOffset = origDest - origEndOfInstr -128 <= origRelOffset && origRelOffset <= 127 end @@ -11246,7 +11253,7 @@ namespace ProviderImplementation.ProvidedTypes | DT_R4 -> i_stind_r4 | DT_R8 -> i_stind_r8 | DT_REF -> i_stind_ref - | _ -> failwith "stelem") + | x -> failwithf "stelem %O" x) | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch, None) labs @@ -11278,12 +11285,12 @@ namespace ProviderImplementation.ProvidedTypes | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeDef -> getUncodedToken ILTableNames.TypeDef idx | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeRef -> getUncodedToken ILTableNames.TypeRef idx | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeSpec -> getUncodedToken ILTableNames.TypeSpec idx - | _ -> failwith "?" + | x -> failwithf "%O ?" x | ILToken.ILMethod mspec -> match GetMethodSpecAsMethodDefOrRef cenv env (mspec, None) with | (tag, idx) when tag = MethodDefOrRefTag.MethodDef -> getUncodedToken ILTableNames.Method idx | (tag, idx) when tag = MethodDefOrRefTag.MemberRef -> getUncodedToken ILTableNames.MemberRef idx - | _ -> failwith "?" + | x -> failwithf "%O ?" x | ILToken.ILField fspec -> match GetFieldSpecAsFieldDefOrRef cenv env fspec with @@ -11466,7 +11473,7 @@ namespace ProviderImplementation.ProvidedTypes let pc2pos = Array.zeroCreate (instrs.Length+1) let pc2labs = Dictionary() for (KeyValue(lab, pc)) in code.Labels do - if pc2labs.ContainsKey pc then pc2labs[pc] <- lab :: pc2labs[pc] else pc2labs[pc] <- [lab] + match pc2labs.TryGetValue pc with | true, pcVal -> pc2labs.[pc] <- lab :: pcVal | false, _ -> pc2labs.[pc] <- [lab] // Emit the instructions for pc = 0 to instrs.Length do @@ -11690,14 +11697,14 @@ namespace ProviderImplementation.ProvidedTypes SharedRow [| UShort (uint16 idx) UShort (uint16 flags) - TypeOrMethodDef (fst owner, snd owner) + TypeOrMethodDef owner StringE (GetStringHeapIdx cenv gp.Name) TypeDefOrRefOrSpec (TypeDefOrRefOrSpecTag.TypeDef, 0) (* empty kind field in deprecated metadata *) |] else SharedRow [| UShort (uint16 idx) UShort (uint16 flags) - TypeOrMethodDef (fst owner, snd owner) + TypeOrMethodDef owner StringE (GetStringHeapIdx cenv gp.Name) |] and GenTypeAsGenericParamConstraintRow cenv env gpidx ty = @@ -12026,7 +12033,7 @@ namespace ProviderImplementation.ProvidedTypes [| data ULong (match r.Access with ILResourceAccess.Public -> 0x01 | ILResourceAccess.Private -> 0x02) StringE (GetStringHeapIdx cenv r.Name) - Implementation (fst impl, snd impl) |] + Implementation impl |] and GenResourcePass3 cenv r = let idx = AddUnsharedRow cenv ILTableNames.ManifestResource (GetResourceAsManifestResourceRow cenv r) @@ -12124,7 +12131,7 @@ namespace ProviderImplementation.ProvidedTypes ULong 0x0 nelem nselem - Implementation (fst impl, snd impl) |]) + Implementation impl |]) GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ExportedType, cidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv cidx ce.Nested @@ -12168,8 +12175,9 @@ namespace ProviderImplementation.ProvidedTypes // Record the entrypoint decl if needed. match m.EntrypointElsewhere with | Some mref -> - if cenv.entrypoint <> None then failwith "duplicate entrypoint" - else cenv.entrypoint <- Some (false, GetModuleRefAsIdx cenv mref) + match cenv.entrypoint with + | Some e -> failwithf "duplicate entrypoint %O" e + | None -> cenv.entrypoint <- Some (false, GetModuleRefAsIdx cenv mref) | None -> () and newGuid (modul: ILModuleDef) = @@ -13928,7 +13936,7 @@ namespace ProviderImplementation.ProvidedTypes |> Array.tryFind (fun x -> x.Name = name - && x.ReturnType = returnType + && Type.(=)(x.ReturnType, returnType) && (x.GetParameters() |> Array.map (fun i -> i.ParameterType)) = tps) @@ -14174,13 +14182,13 @@ namespace ProviderImplementation.ProvidedTypes let pop () = ilg.Emit(I_pop) let popIfEmptyExpected s = if isEmpty s then pop() let emitConvIfNecessary t1 = - if t1 = typeof then + if Type.(=)(t1, typeof) then ilg.Emit(I_conv DT_I2) - elif t1 = typeof then + elif Type.(=)(t1, typeof) then ilg.Emit(I_conv DT_U2) - elif t1 = typeof then + elif Type.(=)(t1, typeof) then ilg.Emit(I_conv DT_I1) - elif t1 = typeof then + elif Type.(=)(t1, typeof) then ilg.Emit(I_conv DT_U1) // emits given expression to corresponding IL match expr with @@ -14854,7 +14862,7 @@ namespace ProviderImplementation.ProvidedTypes |> Array.tryFind (fun x -> x.Name = "op_Explicit" - && x.ReturnType = rtTgt + && Type.(=)(x.ReturnType, rtTgt) && (x.GetParameters() |> Array.map (fun i -> i.ParameterType)) = [|t1|]) match m with | None -> @@ -15086,7 +15094,7 @@ namespace ProviderImplementation.ProvidedTypes | false, true -> // method produced something, but we don't need it pop() - | true, false when expr.Type = typeof -> + | true, false when Type.(=)(expr.Type, typeof) -> // if we need result and method produce void and result should be unit - push null as unit value on stack ilg.Emit(I_ldnull) | _ -> () @@ -15122,7 +15130,7 @@ namespace ProviderImplementation.ProvidedTypes | :? float32 as x -> ilg.Emit(I_ldc (DT_R4, ILConst.R4 x)) | :? float as x -> ilg.Emit(I_ldc(DT_R8, ILConst.R8 x)) #if !FX_NO_GET_ENUM_UNDERLYING_TYPE - | :? Enum as x when x.GetType().GetEnumUnderlyingType() = typeof -> ilg.Emit(mk_ldc (unbox v)) + | :? Enum as x when Type.(=) (x.GetType().GetEnumUnderlyingType(), typeof) -> ilg.Emit(mk_ldc (unbox v)) #endif | :? Type as ty -> ilg.Emit(I_ldtoken (ILToken.ILType (transType ty))) @@ -15319,7 +15327,7 @@ namespace ProviderImplementation.ProvidedTypes and transTypeRefScope (ty: Type): ILTypeRefScope = match ty.DeclaringType with | null -> - if ty.Assembly = null then failwithf "null assembly for type %s" ty.FullName + if isNull ty.Assembly then failwithf "null assembly for type %s" ty.FullName ILTypeRefScope.Top (transScopeRef ty.Assembly) | dt -> ILTypeRefScope.Nested (transTypeRef dt) @@ -15439,7 +15447,7 @@ namespace ProviderImplementation.ProvidedTypes let otb, _ = ((None, ""), ns) ||> List.fold (fun (otb:ILTypeBuilder option, fullName) n -> let fullName = if fullName = "" then n else fullName + "." + n - let priorType = if typeMapExtra.ContainsKey(fullName) then Some typeMapExtra[fullName] else None + let priorType = match typeMapExtra.TryGetValue fullName with | true, typeVal -> Some typeVal | false, _ -> None let tb = match priorType with | Some tbb -> tbb @@ -15512,21 +15520,23 @@ namespace ProviderImplementation.ProvidedTypes | :? ProvidedMethod as pminfo when not (methMap.ContainsKey pminfo) -> let mb = tb.DefineMethod(minfo.Name, minfo.Attributes, transType minfo.ReturnType, [| for p in minfo.GetParameters() -> transType p.ParameterType |]) + let ctorTy1 = typeof + let ctor1 = ctorTy1.GetConstructor([|typeof|]) + let ctorTgt1 = context.ConvertSourceConstructorRefToTarget ctor1 + + let ctorTy2 = typeof + let ctor2 = ctorTy2.GetConstructor([||]) + let ctorTgt2 = context.ConvertSourceConstructorRefToTarget ctor2 + for (i, p) in minfo.GetParameters() |> Seq.mapi (fun i x -> (i, x :?> ProvidedParameter)) do let pb = mb.DefineParameter(i+1, p.Attributes, p.Name) if p.HasDefaultParameterValue then - let ctorTy = typeof - let ctor = ctorTy.GetConstructor([|typeof|]) - let ctorTgt = context.ConvertSourceConstructorRefToTarget ctor - let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt, [p.RawDefaultValue], [], []) + let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt1, [p.RawDefaultValue], [], []) pb.SetCustomAttribute ca - let ctorTy = typeof - let ctor = ctorTy.GetConstructor([||]) - let ctorTgt = context.ConvertSourceConstructorRefToTarget ctor - let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt, [], [], []) + let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt2, [], [], []) pb.SetCustomAttribute ca pb.SetConstant p.RawDefaultValue @@ -15766,7 +15776,7 @@ namespace ProviderImplementation.ProvidedTypes failwithf "expected identical assembly name keys '%s' and '%s'" origAssemblyName newAssemblyName // check the type really exists - if t.Assembly.GetType(tyName) = null then + if isNull (t.Assembly.GetType tyName) then failwithf "couldn't find type '%s' in assembly '%O'" tyName t.Assembly t @@ -15903,7 +15913,7 @@ namespace ProviderImplementation.ProvidedTypes | :? ProvidedMethod as mT when (match methodBaseT.DeclaringType with :? ProvidedTypeDefinition as pt -> pt.IsErased | _ -> true) -> match mT.GetInvokeCode with | Some _ when methodBaseT.DeclaringType.IsInterface -> - failwith "The provided type definition is an interface; therefore, it should not define an implementation for its members." + failwithf "The provided type definition is an interface; therefore, it should not define an implementation for its members. %O" methodBaseT.DeclaringType (* NOTE: These checks appear to fail for generative abstract and virtual methods. | Some _ when mT.IsAbstract -> failwith "The provided method is defined as abstract; therefore, it should not define an implementation."