diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 0fdcde7e13a..6f319030449 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fantomas": { - "version": "5.0.0-beta-005", + "version": "5.0.3", "commands": [ "fantomas" ] diff --git a/.fantomasignore b/.fantomasignore index a3094f05991..fabfd3547e1 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -12,14 +12,79 @@ artifacts/ # Explicitly unformatted implementation files -src/Compiler/Checking/**/*.fs -src/Compiler/DependencyManager/**/*.fs -src/Compiler/Facilities/**/*.fs -src/Compiler/Interactive/**/*.fs -src/Compiler/Legacy/**/*.fs -src/Compiler/Optimize/**/*.fs -src/Compiler/Symbols/**/*.fs -src/Compiler/TypedTree/**/*.fs +src/Compiler/Checking/AccessibilityLogic.fs +src/Compiler/Checking/AttributeChecking.fs +src/Compiler/Checking/AugmentWithHashCompare.fs +src/Compiler/Checking/CheckBasics.fs +src/Compiler/Checking/CheckComputationExpressions.fs +src/Compiler/Checking/CheckDeclarations.fs +src/Compiler/Checking/CheckExpressions.fs +src/Compiler/Checking/CheckFormatStrings.fs +src/Compiler/Checking/CheckIncrementalClasses.fs +src/Compiler/Checking/CheckPatterns.fs +src/Compiler/Checking/ConstraintSolver.fs +src/Compiler/Checking/FindUnsolved.fs +src/Compiler/Checking/import.fs +src/Compiler/Checking/InfoReader.fs +src/Compiler/Checking/infos.fs +src/Compiler/Checking/MethodCalls.fs +src/Compiler/Checking/MethodOverrides.fs +src/Compiler/Checking/NameResolution.fs +src/Compiler/Checking/NicePrint.fs +src/Compiler/Checking/PatternMatchCompilation.fs +src/Compiler/Checking/PostInferenceChecks.fs +src/Compiler/Checking/QuotationTranslator.fs +src/Compiler/Checking/SignatureConformance.fs +src/Compiler/Checking/TypeHierarchy.fs +src/Compiler/Checking/TypeRelations.fs + +src/Compiler/DependencyManager/AssemblyResolveHandler.fs +src/Compiler/DependencyManager/DependencyProvider.fs +src/Compiler/DependencyManager/NativeDllResolveHandler.fs + +src/Compiler/Facilities/BuildGraph.fs +src/Compiler/Facilities/CompilerLocation.fs +src/Compiler/Facilities/DiagnosticOptions.fs +src/Compiler/Facilities/DiagnosticResolutionHints.fs +src/Compiler/Facilities/DiagnosticsLogger.fs +src/Compiler/Facilities/LanguageFeatures.fs +src/Compiler/Facilities/Logger.fs +src/Compiler/Facilities/prim-lexing.fs +src/Compiler/Facilities/prim-parsing.fs +src/Compiler/Facilities/ReferenceResolver.fs +src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs +src/Compiler/Facilities/TextLayoutRender.fs + +src/Compiler/Interactive/ControlledExecution.fs +src/Compiler/Interactive/fsi.fs + +src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +src/Compiler/Legacy/LegacyMSBuildReferenceResolver.fs + +src/Compiler/Optimize/DetupleArgs.fs +src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs +src/Compiler/Optimize/LowerCalls.fs +src/Compiler/Optimize/LowerComputedCollections.fs +src/Compiler/Optimize/LowerLocalMutables.fs +src/Compiler/Optimize/LowerSequences.fs +src/Compiler/Optimize/LowerStateMachines.fs +src/Compiler/Optimize/Optimizer.fs + +src/Compiler/Symbols/Exprs.fs +src/Compiler/Symbols/FSharpDiagnostic.fs +src/Compiler/Symbols/SymbolHelpers.fs +src/Compiler/Symbols/SymbolPatterns.fs +src/Compiler/Symbols/Symbols.fs + +src/Compiler/TypedTree/CompilerGlobalState.fs +src/Compiler/TypedTree/QuotationPickler.fs +src/Compiler/TypedTree/tainted.fs +src/Compiler/TypedTree/TcGlobals.fs +src/Compiler/TypedTree/TypedTree.fs +src/Compiler/TypedTree/TypedTreeBasics.fs +src/Compiler/TypedTree/TypedTreeOps.fs +src/Compiler/TypedTree/TypedTreePickle.fs +src/Compiler/TypedTree/TypeProviders.fs # Explicitly unformatted file that needs more care to get it to format well diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index 6c1de31c1b2..6a22a1cca73 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -2,7 +2,7 @@ name: Bug report about: Create a report to help us improve F# title: '' -labels: Bug +labels: [Bug, Needs-Triage] assignees: '' --- diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml new file mode 100644 index 00000000000..2af3faa3c0c --- /dev/null +++ b/.github/ISSUE_TEMPLATE/config.yml @@ -0,0 +1,11 @@ +blank_issues_enabled: true +contact_links: + - name: F# Discussions + url: https://github.com/dotnet/fsharp/discussions + about: Please ask and answer questions here. + - name: F# Language Suggestions + url: https://github.com/fsharp/fslang-suggestions + about: Language features discussions here. + - name: F# Language Design + url: https://github.com/fsharp/fslang-design + about: Language design RFCs here. diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md index 1397683d28c..9902369d951 100644 --- a/.github/ISSUE_TEMPLATE/feature_request.md +++ b/.github/ISSUE_TEMPLATE/feature_request.md @@ -2,7 +2,7 @@ name: Feature request about: Suggest an idea for the F# tools or compiler title: '' -labels: Feature Request +labels: [Feature Request, Needs-Triage] assignees: '' --- diff --git a/.github/ISSUE_TEMPLATE/other_issue.md b/.github/ISSUE_TEMPLATE/other_issue.md new file mode 100644 index 00000000000..9f737b857bc --- /dev/null +++ b/.github/ISSUE_TEMPLATE/other_issue.md @@ -0,0 +1,10 @@ +--- +name: Other issue +about: Open an issue which does not belong to any categories above +title: '' +labels: [Needs-Triage] +assignees: '' + +--- + + diff --git a/.github/workflows/add_to_project.yml b/.github/workflows/add_to_project.yml new file mode 100644 index 00000000000..796494e4b29 --- /dev/null +++ b/.github/workflows/add_to_project.yml @@ -0,0 +1,31 @@ +name: Add all issues to F# project + +on: + issues: + types: + - opened + - transferred + +jobs: + cleanup_old_runs: + runs-on: ubuntu-20.04 + permissions: + actions: write + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + steps: + - name: Delete old workflow runs + run: | + _UrlPath="/repos/$GITHUB_REPOSITORY/actions/workflows" + _CurrentWorkflowID="$(gh api -X GET "$_UrlPath" | jq '.workflows[] | select(.name == '\""$GITHUB_WORKFLOW"\"') | .id')" + gh api -X GET "$_UrlPath/$_CurrentWorkflowID/runs" --paginate \ + | jq '.workflow_runs[] | select(.status == "completed") | .id' \ + | xargs -I{} gh api -X DELETE "/repos/$GITHUB_REPOSITORY/actions/runs"/{} + add-to-project: + name: Add issue to project + runs-on: ubuntu-latest + steps: + - uses: actions/add-to-project@v0.3.0 + with: + project-url: https://github.com/orgs/dotnet/projects/126/ + github-token: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/backport.yml b/.github/workflows/backport.yml new file mode 100644 index 00000000000..5f6fe9827f2 --- /dev/null +++ b/.github/workflows/backport.yml @@ -0,0 +1,83 @@ +name: Backport PR to branch +on: + issue_comment: + types: [created] + schedule: + # once a day at 13:00 UTC + - cron: '0 13 * * *' + +permissions: + contents: write + issues: write + pull-requests: write + +jobs: + cleanup_old_runs: + if: github.event.schedule == '0 13 * * *' + runs-on: ubuntu-20.04 + permissions: + actions: write + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + steps: + - name: Delete old workflow runs + run: | + _UrlPath="/repos/$GITHUB_REPOSITORY/actions/workflows" + _CurrentWorkflowID="$(gh api -X GET "$_UrlPath" | jq '.workflows[] | select(.name == '\""$GITHUB_WORKFLOW"\"') | .id')" + + # delete workitems which are 'completed'. (other candidate values of status field are: 'queued' and 'in_progress') + + gh api -X GET "$_UrlPath/$_CurrentWorkflowID/runs" --paginate \ + | jq '.workflow_runs[] | select(.status == "completed") | .id' \ + | xargs -I{} gh api -X DELETE "/repos/$GITHUB_REPOSITORY/actions/runs"/{} + + backport: + if: github.event.issue.pull_request != '' && contains(github.event.comment.body, '/backport to') + runs-on: ubuntu-20.04 + steps: + - name: Extract backport target branch + uses: actions/github-script@v3 + id: target-branch-extractor + with: + result-encoding: string + script: | + if (context.eventName !== "issue_comment") throw "Error: This action only works on issue_comment events."; + + // extract the target branch name from the trigger phrase containing these characters: a-z, A-Z, digits, forward slash, dot, hyphen, underscore + const regex = /^\/backport to ([a-zA-Z\d\/\.\-\_]+)/; + target_branch = regex.exec(context.payload.comment.body); + if (target_branch == null) throw "Error: No backport branch found in the trigger phrase."; + + return target_branch[1]; + - name: Post backport started comment to pull request + uses: actions/github-script@v3 + with: + script: | + const backport_start_body = `Started backporting to ${{ steps.target-branch-extractor.outputs.result }}: https://github.com/${context.repo.owner}/${context.repo.repo}/actions/runs/${process.env.GITHUB_RUN_ID}`; + await github.issues.createComment({ + issue_number: context.issue.number, + owner: context.repo.owner, + repo: context.repo.repo, + body: backport_start_body + }); + - name: Checkout repo + uses: actions/checkout@v2 + with: + fetch-depth: 0 + - name: Run backport + uses: ./eng/actions/backport + with: + target_branch: ${{ steps.target-branch-extractor.outputs.result }} + auth_token: ${{ secrets.GITHUB_TOKEN }} + pr_description_template: | + Backport of #%source_pr_number% to %target_branch% + + /cc %cc_users% + + ## Customer Impact + + ## Testing + + ## Risk + + IMPORTANT: Is this backport for a servicing release? If so and this change touches code that ships in a NuGet package, please make certain that you have added any necessary [package authoring](https://github.com/dotnet/runtime/blob/main/docs/project/library-servicing.md) and gotten it explicitly reviewed. diff --git a/DEVGUIDE.md b/DEVGUIDE.md index 2f7d899e329..da02c907c22 100644 --- a/DEVGUIDE.md +++ b/DEVGUIDE.md @@ -44,12 +44,12 @@ This will update your fork with the latest from `dotnet/fsharp` on your machine ## Developing on Windows -Install the latest released [Visual Studio](https://www.visualstudio.com/downloads/), as that is what the `main` branch's tools are synced with. Select the following workloads: +Install the latest released [Visual Studio](https://visualstudio.microsoft.com/vs/preview/) preview, as that is what the `main` branch's tools are synced with. Select the following workloads: * .NET desktop development (also check F# desktop support, as this will install some legacy templates) * Visual Studio extension development -You will also need the latest .NET 6 SDK installed from [here](https://dotnet.microsoft.com/download/dotnet/6.0). +You will also need the latest .NET 7 SDK installed from [here](https://dotnet.microsoft.com/download/dotnet/7.0). Building is simple: @@ -73,10 +73,10 @@ If you don't have everything installed yet, you'll get prompted by Visual Studio If you are just developing the core compiler and library then building ``FSharp.sln`` will be enough. -We recommend installing the latest released Visual Studio and using that if you are on Windows. However, if you prefer not to do that, you will need to install the following: +We recommend installing the latest Visual Studio preview and using that if you are on Windows. However, if you prefer not to do that, you will need to install the following: * [.NET Framework 4.7.2](https://dotnet.microsoft.com/download/dotnet-framework/net472) -* [.NET 6](https://dotnet.microsoft.com/download/dotnet/6.0) +* [.NET 7](https://dotnet.microsoft.com/download/dotnet/7.0) You'll need to pass an additional flag to the build script: diff --git a/Directory.Build.props b/Directory.Build.props index de4eb4723e5..0d93c757059 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -3,6 +3,15 @@ + + + true + + diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 7a349c38471..0c8d9cef75c 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -26,6 +26,7 @@ 1182;0025;$(WarningsAsErrors) $(OtherFlags) --nowarn:3384 $(OtherFlags) --times --nowarn:75 + $(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn diff --git a/INTERNAL.md b/INTERNAL.md index 9d8ae1ced46..4993301cb36 100644 --- a/INTERNAL.md +++ b/INTERNAL.md @@ -77,6 +77,17 @@ Update the `insertTargetBranch` value at the bottom of `azure-pipelines.yml` in 7. Note, the help in the `darc` tool is really good. E.g., you can simply run `darc` to see a list of all commands available, and if you run `darc ` with no arguments, you'll be given a list of arguments you can use. 8. Ensure that version numbers are bumped for a new branch. +## Labeling issues on GitHub + +Assign appropriate `Area-*` label to bugs, feature improvements and feature requests issues alike. List of `Area` labels with descriptions can be found [here](https://github.com/dotnet/fsharp/labels?q=Area). These areas are laid out to follow the logical organization of the code. + +To find all existing open issues without assigned `Area` label, use [this query](https://github.com/dotnet/fsharp/issues?q=is%3Aissue+is%3Aopen+-label%3AArea-AOT+-label%3AArea-Async+-label%3AArea-Build+-label%3AArea-Compiler+-label%3AArea-Compiler-Checking+-label%3AArea-Compiler-CodeGen+-label%3AArea-Compiler-HashCompare+-label%3AArea-Compiler-ImportAndInterop+-label%3AArea-Compiler-Optimization+-label%3AArea-Compiler-Options+-label%3AArea-Compiler-PatternMatching+-label%3AArea-Compiler-Service+-label%3AArea-Compiler-SigFileGen+-label%3AArea-Compiler-SRTP+-label%3AArea-Compiler-StateMachines+-label%3AArea-Compiler-Syntax+-label%3AArea-ComputationExpressions+-label%3AArea-Debug+-label%3AArea-DependencyManager+-label%3AArea-Diagnostics+-label%3AArea-FCS+-label%3AArea-FSC+-label%3AArea-FSI+-label%3AArea-Infrastructure+-label%3AArea-LangService-API+-label%3AArea-LangService-AutoComplete+-label%3AArea-LangService-BlockStructure+-label%3AArea-LangService-CodeLens+-label%3AArea-LangService-Colorization+-label%3AArea-LangService-Diagnostics+-label%3AArea-LangService-FindAllReferences+-label%3AArea-LangService-Navigation+-label%3AArea-LangService-QuickFixes+-label%3AArea-LangService-RenameSymbol+-label%3AArea-LangService-ToolTips+-label%3AArea-LangService-UnusedDeclarations+-label%3AArea-LangService-UnusedOpens+-label%3AArea-Library+-label%3AArea-ProjectsAndBuild+-label%3AArea-Queries+-label%3AArea-Quotations+-label%3AArea-SetupAndDelivery+-label%3AArea-Testing+-label%3AArea-TypeProviders+-label%3AArea-UoM+-label%3AArea-VS+-label%3AArea-VS-Editor+-label%3AArea-VS-FSI+-label%3AArea-XmlDocs) + +Since github issue filtering is currently not flexible enough, that query was generated by pasting output of this PowerShell command to the search box (might need to be rerun if new kinds of `Area` labels are added): +```ps1 +Invoke-WebRequest -Uri "https://api.github.com/repos/dotnet/fsharp/labels?per_page=100" | ConvertFrom-Json | % { $_.name } | ? { $_.StartsWith("Area-") } | % { Write-Host -NoNewLine ('-label:"' + $_ + '" ') } +``` + ## Less interesting links [FSharp.Core (Official NuGet Release)](https://dev.azure.com/dnceng/internal/_release?_a=releases&definitionId=72). diff --git a/NuGet.config b/NuGet.config index c6b6cb09dd7..5b0a8ef0a09 100644 --- a/NuGet.config +++ b/NuGet.config @@ -9,7 +9,9 @@ - + + + diff --git a/README.md b/README.md index 3107814f512..2026df28022 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,11 @@ # The F# compiler, F# core library, and F# editor tools +[![Build Status](https://dev.azure.com/dnceng-public/public/_apis/build/status/dotnet/fsharp/fsharp-ci?branchName=main)](https://dev.azure.com/dnceng-public/public/_build/latest?definitionId=90&branchName=main) +[![Help Wanted](https://img.shields.io/github/issues/dotnet/fsharp/help%20wanted?style=flat-square&color=%232EA043&label=help%20wanted)](https://github.com/dotnet/runtime/labels/help%20wanted) + You're invited to contribute to future releases of the F# compiler, core library, and tools. Development of this repository can be done on any OS supported by [.NET](https://dotnet.microsoft.com/). -You will also need the latest .NET 6 SDK installed from [here](https://dotnet.microsoft.com/download/dotnet/6.0). +You will also need the latest .NET 7 SDK installed from [here](https://dotnet.microsoft.com/download/dotnet/7.0). ## Contributing @@ -54,12 +57,6 @@ After it's finished, open `FSharp.sln` in your editor of choice. Even if you find a single-character typo, we're happy to take the change! Although the codebase can feel daunting for beginners, we and other contributors are happy to help you along. -## Build Status - -| Branch | Status | -|:------:|:------:| -|main|[![Build Status](https://dev.azure.com/dnceng/public/_apis/build/status/dotnet/fsharp/fsharp-ci?branchName=main)](https://dev.azure.com/dnceng/public/_build/latest?definitionId=496&branchName=main)| - ## Per-build NuGet packages Per-build [versions](https://dev.azure.com/dnceng/public/_packaging?_a=package&feed=dotnet-tools&view=versions&package=FSharp.Compiler.Service&protocolType=NuGet) of our NuGet packages are available via this URL: `https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools/nuget/v3/index.json` diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 65e3e0fa007..d739dc40ac2 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -508,6 +508,36 @@ stages: # filePath: eng\tests\UpToDate.ps1 # arguments: -configuration $(_BuildConfig) -ci -binaryLog + # Run Build with --test:ParallelCheckingWithSignatureFilesOn + - job: ParallelCheckingWithSignatureFiles + condition: eq(variables['Build.Reason'], 'PullRequest') + variables: + - name: _SignType + value: Test + pool: + name: NetCore-Public + demands: ImageOverride -equals $(WindowsMachineQueueName) + timeoutInMinutes: 90 + steps: + - checkout: self + clean: true + - task: UseDotNet@2 + displayName: install SDK + inputs: + packageType: sdk + useGlobalJson: true + includePreviewVersions: false + workingDirectory: $(Build.SourcesDirectory) + installationPath: $(Build.SourcesDirectory)/.dotnet + - script: .\build.cmd -c Release -binaryLog /p:ParallelCheckingWithSignatureFilesOn=true + displayName: ParallelCheckingWithSignatureFiles build with Debug configuration + - task: PublishPipelineArtifact@1 + displayName: Publish ParallelCheckingWithSignatureFiles Logs + inputs: + targetPath: '$(Build.SourcesDirectory)/artifacts/log/Release' + artifactName: 'ParallelCheckingWithSignatureFiles Attempt $(System.JobAttempt) Logs' + continueOnError: true + # Plain build Windows - job: Plain_Build_Windows pool: diff --git a/eng/SourceBuild.props b/eng/SourceBuild.props index 949c084ed77..0be49467823 100644 --- a/eng/SourceBuild.props +++ b/eng/SourceBuild.props @@ -23,8 +23,15 @@ DependsOnTargets="PrepareInnerSourceBuildRepoRoot" BeforeTargets="RunInnerSourceBuildCommand"> + diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index d61aadbec93..a129a95dffa 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -8,14 +8,14 @@ - + https://github.com/dotnet/arcade - bf47db2617320c82f94713d7b538f7bc0fa9d662 + d2d39276af2db3da7816ee2dc543e120d7e5781e - + https://github.com/dotnet/arcade - bf47db2617320c82f94713d7b538f7bc0fa9d662 + d2d39276af2db3da7816ee2dc543e120d7e5781e diff --git a/eng/Versions.props b/eng/Versions.props index 88e7545b0d6..bec5570e719 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -86,27 +86,28 @@ 4.5.1 - 5.0.0 + 6.0.0 1.6.0 5.0.1 4.5.5 4.7.0 - 5.0.0 + 6.0.0 4.11.1 6.0.0 4.5.0 - 4.4.0-1.22368.2 - 17.3.133-preview - 17.3.0-preview-1-32407-044 - 17.0.77-pre-g62a6cb5699 - 17.3.1-alpha - 17.1.0 + 4.4.0-3.22470.1 + 17.4.196-preview + 17.4.0-preview-3-32916-145 + 17.4.342-pre + 17.4.23-alpha + 17.4.0-preview-22469-04 $(RoslynVersion) $(RoslynVersion) $(RoslynVersion) $(RoslynVersion) + $(RoslynVersion) $(RoslynVersion) $(RoslynVersion) $(RoslynVersion) @@ -115,7 +116,7 @@ $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) - $(MicrosoftVisualStudioShellPackagesVersion) + 17.4.0-preview-3-32916-053 $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) @@ -132,8 +133,8 @@ $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) - $(MicrosoftVisualStudioShellPackagesVersion) - $(MicrosoftVisualStudioShellPackagesVersion) + 17.4.0-preview-3-32916-053 + 17.4.0-preview-3-32916-053 $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) $(MicrosoftVisualStudioShellPackagesVersion) @@ -170,9 +171,9 @@ 2.3.6152103 17.1.4054 - 17.3.3-alpha + 17.4.7-alpha 17.0.0 - 17.0.53 + 17.0.64 9.0.30729 6.0.0 12.0.4 @@ -188,7 +189,8 @@ 0.13.2 2.16.5 4.3.0.0 - 1.0.30 + 1.0.31 + 6.0.0 8.0.0 4.3.0-1.22220.8 3.1.0 @@ -202,8 +204,8 @@ 3.11.0 2.1.80 1.0.0-beta2-dev3 - 2.12.7-alpha - 2.8.57 + 2.13.23-alpha + 2.9.87-alpha 2.4.1 2.4.2 5.10.3 diff --git a/eng/common/build.ps1 b/eng/common/build.ps1 index 8943da242f6..33a6f2d0e24 100644 --- a/eng/common/build.ps1 +++ b/eng/common/build.ps1 @@ -26,6 +26,7 @@ Param( [string] $runtimeSourceFeed = '', [string] $runtimeSourceFeedKey = '', [switch] $excludePrereleaseVS, + [switch] $nativeToolsOnMachine, [switch] $help, [Parameter(ValueFromRemainingArguments=$true)][String[]]$properties ) @@ -67,6 +68,7 @@ function Print-Usage() { Write-Host " -warnAsError Sets warnaserror msbuild parameter ('true' or 'false')" Write-Host " -msbuildEngine Msbuild engine to use to run build ('dotnet', 'vs', or unspecified)." Write-Host " -excludePrereleaseVS Set to exclude build engines in prerelease versions of Visual Studio" + Write-Host " -nativeToolsOnMachine Sets the native tools on machine environment variable (indicating that the script should use native tools on machine)" Write-Host "" Write-Host "Command line arguments not listed above are passed thru to msbuild." @@ -146,6 +148,9 @@ try { $nodeReuse = $false } + if ($nativeToolsOnMachine) { + $env:NativeToolsOnMachine = $true + } if ($restore) { InitializeNativeTools } diff --git a/eng/common/cross/build-rootfs.sh b/eng/common/cross/build-rootfs.sh index 5680980fa29..eddb4c380af 100755 --- a/eng/common/cross/build-rootfs.sh +++ b/eng/common/cross/build-rootfs.sh @@ -391,9 +391,9 @@ elif [[ "$__CodeName" == "illumos" ]]; then --with-gnu-ld --disable-nls --disable-libgomp --disable-libquadmath --disable-libssp --disable-libvtv --disable-libcilkrts --disable-libada --disable-libsanitizer \ --disable-libquadmath-support --disable-shared --enable-tls make -j "$JOBS" && make install && cd .. - BaseUrl=https://pkgsrc.joyent.com + BaseUrl=https://pkgsrc.smartos.org if [[ "$__UseMirror" == 1 ]]; then - BaseUrl=http://pkgsrc.smartos.skylime.net + BaseUrl=https://pkgsrc.smartos.skylime.net fi BaseUrl="$BaseUrl/packages/SmartOS/trunk/${__illumosArch}/All" echo "Downloading manifest" @@ -402,7 +402,8 @@ elif [[ "$__CodeName" == "illumos" ]]; then read -ra array <<<"$__IllumosPackages" for package in "${array[@]}"; do echo "Installing '$package'" - package="$(grep ">$package-[0-9]" All | sed -En 's/.*href="(.*)\.tgz".*/\1/p')" + # find last occurrence of package in listing and extract its name + package="$(sed -En '/.*href="('"$package"'-[0-9].*).tgz".*/h;$!d;g;s//\1/p' All)" echo "Resolved name '$package'" wget "$BaseUrl"/"$package".tgz ar -x "$package".tgz diff --git a/eng/common/init-tools-native.ps1 b/eng/common/init-tools-native.ps1 index ac42f04a9d8..fbc67effc36 100644 --- a/eng/common/init-tools-native.ps1 +++ b/eng/common/init-tools-native.ps1 @@ -113,6 +113,7 @@ try { $ToolPath = Convert-Path -Path $BinPath Write-Host "Adding $ToolName to the path ($ToolPath)..." Write-Host "##vso[task.prependpath]$ToolPath" + $env:PATH = "$ToolPath;$env:PATH" $InstalledTools += @{ $ToolName = $ToolDirectory.FullName } } } diff --git a/eng/common/templates/job/execute-sdl.yml b/eng/common/templates/job/execute-sdl.yml index 781a41c9404..65f87b40c66 100644 --- a/eng/common/templates/job/execute-sdl.yml +++ b/eng/common/templates/job/execute-sdl.yml @@ -34,7 +34,7 @@ jobs: - job: Run_SDL dependsOn: ${{ parameters.dependsOn }} displayName: Run SDL tool - condition: eq( ${{ parameters.enable }}, 'true') + condition: and(succeededOrFailed(), eq( ${{ parameters.enable }}, 'true')) variables: - group: DotNet-VSTS-Bot - name: AzDOProjectName diff --git a/eng/common/templates/job/job.yml b/eng/common/templates/job/job.yml index 459f3c4fcbb..9f55d3f4666 100644 --- a/eng/common/templates/job/job.yml +++ b/eng/common/templates/job/job.yml @@ -25,6 +25,7 @@ parameters: enablePublishTestResults: false enablePublishUsingPipelines: false disableComponentGovernance: false + componentGovernanceIgnoreDirectories: '' mergeTestResults: false testRunTitle: '' testResultsFormat: '' @@ -146,6 +147,8 @@ jobs: - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest'), ne(parameters.disableComponentGovernance, 'true')) }}: - task: ComponentGovernanceComponentDetection@0 continueOnError: true + inputs: + ignoreDirectories: ${{ parameters.componentGovernanceIgnoreDirectories }} - ${{ if eq(parameters.enableMicrobuild, 'true') }}: - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: @@ -223,4 +226,5 @@ jobs: parameters: PackageVersion: ${{ parameters.packageVersion}} BuildDropPath: ${{ parameters.buildDropPath }} + IgnoreDirectories: ${{ parameters.componentGovernanceIgnoreDirectories }} diff --git a/eng/common/templates/jobs/source-build.yml b/eng/common/templates/jobs/source-build.yml index 00aa98eb3bf..bcd8279944b 100644 --- a/eng/common/templates/jobs/source-build.yml +++ b/eng/common/templates/jobs/source-build.yml @@ -14,7 +14,7 @@ parameters: # This is the default platform provided by Arcade, intended for use by a managed-only repo. defaultManagedPlatform: name: 'Managed' - container: 'mcr.microsoft.com/dotnet-buildtools/prereqs:centos-7-3e800f1-20190501005343' + container: 'mcr.microsoft.com/dotnet-buildtools/prereqs:centos-stream8-latest' # Defines the platforms on which to run build jobs. One job is created for each platform, and the # object in this array is sent to the job template as 'platform'. If no platforms are specified, diff --git a/eng/common/templates/post-build/post-build.yml b/eng/common/templates/post-build/post-build.yml index 87fcae940cf..258ed2d1108 100644 --- a/eng/common/templates/post-build/post-build.yml +++ b/eng/common/templates/post-build/post-build.yml @@ -98,7 +98,7 @@ stages: jobs: - job: displayName: NuGet Validation - condition: eq( ${{ parameters.enableNugetValidation }}, 'true') + condition: and(succeededOrFailed(), eq( ${{ parameters.enableNugetValidation }}, 'true')) pool: # We don't use the collection uri here because it might vary (.visualstudio.com vs. dev.azure.com) ${{ if eq(variables['System.TeamProject'], 'DevDiv') }}: @@ -282,4 +282,4 @@ stages: -MaestroToken '$(MaestroApiAccessToken)' -WaitPublishingFinish true -ArtifactsPublishingAdditionalParameters '${{ parameters.artifactsPublishingAdditionalParameters }}' - -SymbolPublishingAdditionalParameters '${{ parameters.symbolPublishingAdditionalParameters }}' \ No newline at end of file + -SymbolPublishingAdditionalParameters '${{ parameters.symbolPublishingAdditionalParameters }}' diff --git a/eng/common/templates/steps/generate-sbom.yml b/eng/common/templates/steps/generate-sbom.yml index 4cea8c33187..a06373f38fa 100644 --- a/eng/common/templates/steps/generate-sbom.yml +++ b/eng/common/templates/steps/generate-sbom.yml @@ -2,12 +2,14 @@ # PackageName - The name of the package this SBOM represents. # PackageVersion - The version of the package this SBOM represents. # ManifestDirPath - The path of the directory where the generated manifest files will be placed +# IgnoreDirectories - Directories to ignore for SBOM generation. This will be passed through to the CG component detector. parameters: PackageVersion: 7.0.0 BuildDropPath: '$(Build.SourcesDirectory)/artifacts' PackageName: '.NET' ManifestDirPath: $(Build.ArtifactStagingDirectory)/sbom + IgnoreDirectories: '' sbomContinueOnError: true steps: @@ -34,6 +36,8 @@ steps: BuildDropPath: ${{ parameters.buildDropPath }} PackageVersion: ${{ parameters.packageVersion }} ManifestDirPath: ${{ parameters.manifestDirPath }} + ${{ if ne(parameters.IgnoreDirectories, '') }}: + AdditionalComponentDetectorArgs: '--IgnoreDirectories ${{ parameters.IgnoreDirectories }}' - task: PublishPipelineArtifact@1 displayName: Publish SBOM manifest diff --git a/eng/common/templates/steps/source-build.yml b/eng/common/templates/steps/source-build.yml index 12a8ff94d8e..a97a185a367 100644 --- a/eng/common/templates/steps/source-build.yml +++ b/eng/common/templates/steps/source-build.yml @@ -63,11 +63,21 @@ steps: targetRidArgs='/p:TargetRid=${{ parameters.platform.targetRID }}' fi + runtimeOsArgs= + if [ '${{ parameters.platform.runtimeOS }}' != '' ]; then + runtimeOsArgs='/p:RuntimeOS=${{ parameters.platform.runtimeOS }}' + fi + publishArgs= if [ '${{ parameters.platform.skipPublishValidation }}' != 'true' ]; then publishArgs='--publish' fi + assetManifestFileName=SourceBuild_RidSpecific.xml + if [ '${{ parameters.platform.name }}' != '' ]; then + assetManifestFileName=SourceBuild_${{ parameters.platform.name }}.xml + fi + ${{ coalesce(parameters.platform.buildScript, './build.sh') }} --ci \ --configuration $buildConfig \ --restore --build --pack $publishArgs -bl \ @@ -75,8 +85,10 @@ steps: $internalRuntimeDownloadArgs \ $internalRestoreArgs \ $targetRidArgs \ + $runtimeOsArgs \ /p:SourceBuildNonPortable=${{ parameters.platform.nonPortable }} \ - /p:ArcadeBuildFromSource=true + /p:ArcadeBuildFromSource=true \ + /p:AssetManifestFileName=$assetManifestFileName displayName: Build # Upload build logs for diagnosis. diff --git a/global.json b/global.json index 43313346974..f44a501cf14 100644 --- a/global.json +++ b/global.json @@ -18,7 +18,7 @@ "perl": "5.32.1.1" }, "msbuild-sdks": { - "Microsoft.DotNet.Arcade.Sdk": "8.0.0-beta.22466.3", - "Microsoft.DotNet.Helix.Sdk": "8.0.0-beta.22466.3" + "Microsoft.DotNet.Arcade.Sdk": "8.0.0-beta.22503.1", + "Microsoft.DotNet.Helix.Sdk": "8.0.0-beta.22503.1" } } diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index c323a9eb939..06c50483a2e 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1220,9 +1220,12 @@ type ISeekReadIndexedRowReader<'RowT, 'KeyT, 'T when 'RowT: struct> = abstract CompareKey: 'KeyT -> int abstract ConvertRow: byref<'RowT> -> 'T -let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = +let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = let mutable row = Unchecked.defaultof<'RowT> + let mutable startRid = -1 + let mutable endRid = -1 + if binaryChop then let mutable low = 0 let mutable high = numRows + 1 @@ -1241,12 +1244,12 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR elif c < 0 then high <- mid else fin <- true - let res = ImmutableArray.CreateBuilder() - if high - low > 1 then // now read off rows, forward and backwards let mid = (low + high) / 2 + startRid <- mid + // read backwards let mutable fin = false let mutable curr = mid - 1 @@ -1258,14 +1261,12 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR reader.GetRow(curr, &row) if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + startRid <- curr else fin <- true curr <- curr - 1 - res.Reverse() - // read forward let mutable fin = false let mutable curr = mid @@ -1277,23 +1278,47 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR reader.GetRow(curr, &row) if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + endRid <- curr else fin <- true curr <- curr + 1 - res.ToArray() else - let res = ImmutableArray.CreateBuilder() + let mutable rid = 1 - for i = 1 to numRows do - reader.GetRow(i, &row) + while rid <= numRows && startRid = -1 do + reader.GetRow(rid, &row) if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + startRid <- rid + endRid <- rid + + rid <- rid + 1 + + let mutable fin = false + + while rid <= numRows && not fin do + reader.GetRow(rid, &row) + + if reader.CompareKey(reader.GetKey(&row)) = 0 then + endRid <- rid + else + fin <- true + + startRid, endRid + +let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = + let startRid, endRid = seekReadIndexedRowsRange numRows binaryChop reader + + if startRid <= 0 || endRid < startRid then + [||] + else - res.ToArray() + Array.init (endRid - startRid + 1) (fun i -> + let mutable row = Unchecked.defaultof<'RowT> + reader.GetRow(startRid + i, &row) + reader.ConvertRow(&row)) [] type CustomAttributeRow = diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 983159604c2..80bb791c25f 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -1154,7 +1154,7 @@ let canGenMethodDef (tdef: ILTypeDef) cenv (mdef: ILMethodDef) = | ILMemberAccess.Public -> true // When emitting a reference assembly, do not emit methods that are private/protected/internal unless they are virtual/abstract or provide an explicit interface implementation. | ILMemberAccess.Private | ILMemberAccess.Family | ILMemberAccess.Assembly | ILMemberAccess.FamilyOrAssembly - when mdef.IsVirtual || mdef.IsAbstract || mdef.IsNewSlot || mdef.IsFinal -> true + when mdef.IsVirtual || mdef.IsAbstract || mdef.IsNewSlot || mdef.IsFinal || mdef.IsEntryPoint -> true // When emitting a reference assembly, only generate internal methods if the assembly contains a System.Runtime.CompilerServices.InternalsVisibleToAttribute. | ILMemberAccess.FamilyOrAssembly | ILMemberAccess.Assembly when cenv.hasInternalsVisibleToAttrib -> true diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index d1d50393523..de1aadfc803 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -412,6 +412,9 @@ let CheckEntityAttributes g (tcref: TyconRef) m = CheckILAttributes g (isByrefLikeTyconRef g m tcref) tcref.ILTyconRawMetadata.CustomAttrs m else CheckFSharpAttributes g tcref.Attribs m + +let CheckILEventAttributes g (tcref: TyconRef) cattrs m = + CheckILAttributes g (isByrefLikeTyconRef g m tcref) cattrs m /// Check the attributes associated with a method, returning warnings and errors as data. let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = @@ -507,7 +510,8 @@ let CheckUnionCaseAttributes g (x:UnionCaseRef) m = /// Check the attributes on a record field, returning errors and warnings as data. let CheckRecdFieldAttributes g (x:RecdFieldRef) m = CheckEntityAttributes g x.TyconRef m ++ (fun () -> - CheckFSharpAttributes g x.PropertyAttribs m) + CheckFSharpAttributes g x.PropertyAttribs m) ++ (fun () -> + CheckFSharpAttributes g x.RecdField.FieldAttribs m) /// Check the attributes on an F# value, returning errors and warnings as data. let CheckValAttributes g (x:ValRef) m = diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 3236d3bfdbe..622864eff4e 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -101,3 +101,5 @@ val IsSecurityAttribute: val IsSecurityCriticalAttribute: g: TcGlobals -> Attrib -> bool val IsAssemblyVersionAttribute: g: TcGlobals -> Attrib -> bool + +val CheckILEventAttributes: g: TcGlobals -> tcref: TyconRef -> cattrs: ILAttributes -> m: range -> OperationResult diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index e6fb4014376..18f457ef887 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -328,13 +328,14 @@ type TcFileState = /// Create a new compilation environment static member Create - (g, isScript, niceNameGen, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring, + (g, isScript, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring, tcPat, tcSimplePats, tcSequenceExpressionEntry, tcArrayOrListSequenceExpression, tcComputationExpression) = + let niceNameGen = NiceNameGenerator() let infoReader = InfoReader(g, amap) let instantiationGenerator m tpsorig = FreshenTypars g m tpsorig let nameResolver = NameResolver(g, amap, infoReader, instantiationGenerator) diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 0a156d268d1..389b716e1c8 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -311,7 +311,6 @@ type TcFileState = static member Create: g: TcGlobals * isScript: bool * - niceNameGen: NiceNameGenerator * amap: ImportMap * thisCcu: CcuThunk * isSig: bool * diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index f2e00c12928..dbea68cf195 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -532,7 +532,11 @@ module TcRecdUnionAndEnumDeclarations = error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(), m)) rfields, recordTy - let names = rfields |> List.map (fun f -> f.DisplayNameCore) + let names = rfields + |> Seq.filter (fun f -> not f.rfield_name_generated) + |> Seq.map (fun f -> f.DisplayNameCore) + |> Seq.toList + let xmlDoc = xmldoc.ToXmlDoc(true, Some names) Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis @@ -542,6 +546,7 @@ module TcRecdUnionAndEnumDeclarations = let TcEnumDecl cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) = let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs + match v with | SynConst.Bytes _ | SynConst.UInt16s _ @@ -689,13 +694,12 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) -let MakeSafeInitField (g: TcGlobals) env m isStatic = +let MakeSafeInitField (cenv: cenv) env m isStatic = let id = // Ensure that we have an g.CompilerGlobalState - assert(g.CompilerGlobalState |> Option.isSome) - ident(g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName("init", m), m) + ident(cenv.niceNameGen.FreshCompilerGeneratedName("init", m), m) let taccess = TAccess [env.eAccessPath] - Construct.NewRecdField isStatic None id false g.int_ty true true [] [] XmlDoc.Empty taccess true + Construct.NewRecdField isStatic None id false cenv.g.int_ty true true [] [] XmlDoc.Empty taccess true // Checking of mutually recursive types, members and 'let' bindings in classes // @@ -1269,7 +1273,7 @@ module MutRecBindingChecking = | _ -> false) if needsSafeStaticInit && hasStaticBindings then - let rfield = MakeSafeInitField g envForDecls tcref.Range true + let rfield = MakeSafeInitField cenv envForDecls tcref.Range true SafeInitField(mkRecdFieldRef tcref rfield.LogicalName, rfield) else NoSafeInitInfo @@ -2427,7 +2431,7 @@ module EstablishTypeDefinitionCores = let ComputeInstanceSafeInitInfo (cenv: cenv) env m thisTy = let g = cenv.g if InstanceMembersNeedSafeInitCheck cenv m thisTy then - let rfield = MakeSafeInitField g env m false + let rfield = MakeSafeInitField cenv env m false let tcref = tcrefOfAppTy g thisTy SafeInitField (mkRecdFieldRef tcref rfield.LogicalName, rfield) else @@ -4480,7 +4484,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE // Publish the combined module type env.eModuleOrNamespaceTypeAccumulator.Value <- - CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] + CombineCcuContentFragments [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] env return env @@ -4802,7 +4806,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // Publish the combined module type env.eModuleOrNamespaceTypeAccumulator.Value <- - CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] + CombineCcuContentFragments [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] env, openDecls let moduleContentsRoot = BuildRootModuleContents kind.IsModule enclosingNamespacePath envNS.eCompPath moduleContents @@ -5158,7 +5162,7 @@ let MakeInitialEnv env = /// Typecheck, then close the inference scope and then check the file meets its signature (if any) let CheckOneImplFile // checkForErrors: A function to help us stop reporting cascading errors - (g, niceNameGen, amap, + (g, amap, thisCcu, openDecls0, checkForErrors, @@ -5173,9 +5177,14 @@ let CheckOneImplFile let infoReader = InfoReader(g, amap) cancellable { - use _ = Activity.instance.Start "CheckOneImplFile" [|"fileName", fileName; "qualifiedNameOfFile", qualNameOfFile.Text|] + use _ = + Activity.Start "CheckDeclarations.CheckOneImplFile" + [| + "fileName", fileName + "qualifiedNameOfFile", qualNameOfFile.Text + |] let cenv = - cenv.Create (g, isScript, niceNameGen, amap, thisCcu, false, Option.isSome rootSigOpt, + cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring, tcPat=TcPat, tcSimplePats=TcSimplePats, @@ -5293,24 +5302,23 @@ let CheckOneImplFile let implFile = CheckedImplFile (qualNameOfFile, scopedPragmas, implFileTy, implFileContents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode) - return (topAttrs, implFile, implFileTypePriorToSig, envAtEnd, cenv.createsGeneratedProvidedTypes) + return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes) } /// Check an entire signature file -let CheckOneSigFile (g, niceNameGen, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (fileName = fileName; qualifiedNameOfFile = qualNameOfFile; modules = sigFileFrags)) = - cancellable { +let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (sigFile: ParsedSigFileInput) = + cancellable { use _ = - Activity.instance.Start "CheckOneSigFile" + Activity.Start "CheckDeclarations.CheckOneSigFile" [| - "fileName", fileName - "qualifiedNameOfFile", qualNameOfFile.Text + "fileName", sigFile.FileName + "qualifiedNameOfFile", sigFile.QualifiedName.Text |] - let cenv = cenv.Create - (g, false, niceNameGen, amap, thisCcu, true, false, conditionalDefines, tcSink, + (g, false, amap, thisCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring, tcPat=TcPat, tcSimplePats=TcSimplePats, @@ -5320,8 +5328,8 @@ let CheckOneSigFile (g, niceNameGen, amap, thisCcu, checkForErrors, conditionalD let envinner, moduleTyAcc = MakeInitialEnv tcEnv - let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment x ] - let! tcEnv = TcSignatureElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None specs + let specs = [ for x in sigFile.Contents -> SynModuleSigDecl.NamespaceFragment x ] + let! tcEnv = TcSignatureElements cenv ParentNone sigFile.QualifiedName.Range envinner PreXmlDoc.Empty None specs let sigFileType = moduleTyAcc.Value @@ -5329,7 +5337,7 @@ let CheckOneSigFile (g, niceNameGen, amap, thisCcu, checkForErrors, conditionalD try sigFileType |> IterTyconsOfModuleOrNamespaceType (fun tycon -> FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv, tycon)) - with exn -> errorRecovery exn qualNameOfFile.Range + with exn -> errorRecovery exn sigFile.QualifiedName.Range return (tcEnv, sigFileType, cenv.createsGeneratedProvidedTypes) } diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index 8a858bca0c4..00033bfb9d6 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -49,7 +49,6 @@ val AddLocalSubModule: val CheckOneImplFile: TcGlobals * - NiceNameGenerator * ImportMap * CcuThunk * OpenDeclaration list * @@ -60,17 +59,10 @@ val CheckOneImplFile: TcEnv * ModuleOrNamespaceType option * ParsedImplFileInput -> - Cancellable + Cancellable val CheckOneSigFile: - TcGlobals * - NiceNameGenerator * - ImportMap * - CcuThunk * - (unit -> bool) * - ConditionalDefines option * - TcResultsSink * - bool -> + TcGlobals * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines option * TcResultsSink * bool -> TcEnv -> ParsedSigFileInput -> Cancellable diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 6aade43c55f..bd675aba272 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -2185,7 +2185,9 @@ module GeneralizationHelpers = | Some memberFlags -> match memberFlags.MemberKind with // can't infer extra polymorphism for properties - | SynMemberKind.PropertyGet | SynMemberKind.PropertySet -> false + | SynMemberKind.PropertyGet + | SynMemberKind.PropertySet + | SynMemberKind.PropertyGetSet -> false // can't infer extra polymorphism for class constructors | SynMemberKind.ClassConstructor -> false // can't infer extra polymorphism for constructors @@ -4773,6 +4775,9 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted info.ProvidedType @@ -9090,7 +9095,9 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delTy mItem ad let objArgs = Option.toList (Option.map fst objDetails) MethInfoChecks g cenv.amap true None objArgs env.eAccessRights mItem delInvokeMeth - + + CheckILEventAttributes g einfo.DeclaringTyconRef (einfo.GetCustomAttrs()) mItem |> CommitOperationResult + // This checks for and drops the 'object' sender let argsTy = ArgsTypeOfEventInfo cenv.infoReader mItem ad einfo if not (slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(cenv.amap, mItem))) then errorR (nonStandardEventError einfo.EventName mItem) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index dccff65781b..70382723f92 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -289,6 +289,11 @@ and TcPat warnOnUpper (cenv: cenv) env valReprInfo vFlags (patEnv: TcPatLinearEn | SynPat.Or (pat1, pat2, m, _) -> TcPatOr warnOnUpper cenv env vFlags patEnv ty pat1 pat2 m + | SynPat.ListCons(pat1, pat2, m, trivia) -> + let longDotId = SynLongIdent((mkSynCaseName trivia.ColonColonRange opNameCons), [], [Some (FSharp.Compiler.SyntaxTrivia.IdentTrivia.OriginalNotation "::")]) + let args = SynArgPats.Pats [ SynPat.Tuple(false, [ pat1; pat2 ], m) ] + TcPatLongIdent warnOnUpper cenv env ad valReprInfo vFlags patEnv ty (longDotId, None, args, None, m) + | SynPat.Ands (pats, m) -> TcPatAnds warnOnUpper cenv env vFlags patEnv ty pats m @@ -471,13 +476,13 @@ and TcNullPat cenv env patEnv ty m = and CheckNoArgsForLiteral args m = match args with | SynArgPats.Pats [] - | SynArgPats.NamePatPairs ([], _) -> () + | SynArgPats.NamePatPairs (pats = []) -> () | _ -> errorR (Error (FSComp.SR.tcLiteralDoesNotTakeArguments (), m)) and GetSynArgPatterns args = match args with | SynArgPats.Pats args -> args - | SynArgPats.NamePatPairs (pairs, _) -> List.map (fun (_, _, pat) -> pat) pairs + | SynArgPats.NamePatPairs (pats = pairs) -> List.map (fun (_, _, pat) -> pat) pairs and TcArgPats warnOnUpper (cenv: cenv) env vFlags patEnv args = let g = cenv.g @@ -565,7 +570,7 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item = UnifyTypes cenv env m overallTy g.exn_ty CheckTyconAccessible cenv.amap m ad ecref |> ignore let mkf mArgs args = TPat_exnconstr(ecref, args, unionRanges m mArgs) - mkf, recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f.Id ] + mkf, recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f ] | Item.UnionCase(ucinfo, showDeprecated) -> if showDeprecated then @@ -582,7 +587,7 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item = let inst = mkTyparInst ucref.TyconRef.TyparsNoRange ucinfo.TypeInst UnifyTypes cenv env m overallTy resTy let mkf mArgs args = TPat_unioncase(ucref, ucinfo.TypeInst, args, unionRanges m mArgs) - mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f.Id ] + mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f] | _ -> invalidArg "item" "not a union case or exception reference" @@ -600,7 +605,7 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m let args, extraPatternsFromNames = match args with | SynArgPats.Pats args -> args, [] - | SynArgPats.NamePatPairs (pairs, m) -> + | SynArgPats.NamePatPairs (pairs, m, _) -> // rewrite patterns from the form (name-N = pat-N; ...) to (..._, pat-N, _...) // so type T = Case of name: int * value: int // | Case(value = v) @@ -610,7 +615,7 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m let extraPatterns = List () for id, _, pat in pairs do - match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with + match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.Id.idText) with | None -> extraPatterns.Add pat match item with @@ -678,7 +683,14 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m elif numArgs < numArgTys then if numArgTys > 1 then // Expects tuple without enough args - errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) + let printTy = NicePrint.minimalStringOfType env.DisplayEnv + let missingArgs = + argNames.[numArgs..numArgTys - 1] + |> List.map (fun id -> (if id.rfield_name_generated then "" else id.DisplayName + ": ") + printTy id.FormalType) + |> String.concat (Environment.NewLine + "\t") + |> fun s -> Environment.NewLine + "\t" + s + + errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments(numArgTys, numArgs, missingArgs), m)) else errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 8feeb65a6a1..c69db854c24 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -244,15 +244,15 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range +exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * error: exn * range: range -exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * range +exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * error: exn * range: range -exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * ContextInfo * parameterRange: range +exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * error: exn * ctxtInfo: ContextInfo * parameterRange: range -exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * exn * range +exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * error: exn * range: range -exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * range +exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * range: range exception UnresolvedConversionOperator of displayEnv: DisplayEnv * TType * TType * range diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index c45db538fc2..ca6a0bc4c47 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -170,33 +170,39 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range +exception ErrorFromApplyingDefault of + tcGlobals: TcGlobals * + displayEnv: DisplayEnv * + Typar * + TType * + error: exn * + range: range exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * - exn * - range + error: exn * + range: range exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * - exn * - ContextInfo * + error: exn * + ctxtInfo: ContextInfo * parameterRange: range -exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * exn * range +exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * error: exn * range: range exception UnresolvedConversionOperator of displayEnv: DisplayEnv * TType * TType * range exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * - range + range: range exception NonRigidTypar of displayEnv: DisplayEnv * string option * range * TType * TType * range diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index dbbe333b9cd..b7b4cce955f 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -875,16 +875,6 @@ module PrintTypes = | [] -> tcL | [arg] -> layoutTypeWithInfoAndPrec denv env 2 arg ^^ tcL | args -> bracketIfL (prec <= 1) (bracketL (layoutTypesWithInfoAndPrec denv env 2 (sepL (tagPunctuation ",")) args) --- tcL) - - and layoutTypeForGenericMultidimensionalArrays denv env prec tcref innerT level = - let innerLayout = layoutTypeWithInfoAndPrec denv env prec innerT - - let arrayLayout = - tagEntityRefName denv tcref $"array{level}d" - |> mkNav tcref.DefinitionRange - |> wordL - - innerLayout ^^ arrayLayout /// Layout a type, taking precedence into account to insert brackets where needed and layoutTypeWithInfoAndPrec denv env prec ty = @@ -906,10 +896,6 @@ module PrintTypes = // Always prefer 'float' to 'float<1>' | TType_app (tc, args, _) when tc.IsMeasureableReprTycon && List.forall (isDimensionless g) args -> layoutTypeWithInfoAndPrec denv env prec (reduceTyconRefMeasureableOrProvided g tc args) - - // Special case for nested array> shape - | TTypeMultiDimensionalArrayAsGeneric (tcref, innerT, level) -> - layoutTypeForGenericMultidimensionalArrays denv env prec tcref innerT level // Layout a type application | TType_ucase (UnionCaseRef(tc, _), args) diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 0b0a5e0624f..2c53c73202e 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -143,7 +143,6 @@ let GetSubExprOfInput g (gtps, tyargs, tinst) (SubExpr(accessf, (ve2, v2))) = // The ints record which choices taken, e.g. tuple/record fields. type Path = | PathQuery of Path * Unique - | PathConj of Path * int | PathTuple of Path * TypeInst * int | PathRecd of Path * TyconRef * TypeInst * int | PathUnionConstr of Path * UnionCaseRef * TypeInst * int @@ -154,7 +153,6 @@ type Path = let rec pathEq p1 p2 = match p1, p2 with | PathQuery(p1, n1), PathQuery(p2, n2) -> (n1 = n2) && pathEq p1 p2 - | PathConj(p1, n1), PathConj(p2, n2) -> (n1 = n2) && pathEq p1 p2 | PathTuple(p1, _, n1), PathTuple(p2, _, n2) -> (n1 = n2) && pathEq p1 p2 | PathRecd(p1, _, _, n1), PathRecd(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 | PathUnionConstr(p1, _, _, n1), PathUnionConstr(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 @@ -203,8 +201,6 @@ let RefuteDiscrimSet g m path discrims = let rec go path tm = match path with | PathQuery _ -> raise CannotRefute - | PathConj (p, _j) -> - go p tm | PathTuple (p, tys, j) -> let k, eCoversVals = mkOneKnown tm j tys go p (fun _ -> mkRefTupled g m k tys, eCoversVals) @@ -391,8 +387,6 @@ type Frontier = Frontier of ClauseNumber * Actives * ValMap type InvestigationPoint = Investigation of ClauseNumber * DecisionTreeTest * Path // Note: actives must be a SortedDictionary -// REVIEW: improve these data structures, though surprisingly these functions don't tend to show up -// on profiling runs let rec isMemOfActives p1 actives = match actives with | [] -> false @@ -1624,7 +1618,7 @@ let CompilePatternBasic subPats |> List.collect (fun subPat -> BindProjectionPattern (Active(inpPath, inpExpr, subPat)) activeState) | TPat_conjs(subPats, _m) -> - let newActives = List.mapi (mkSubActive (fun path j -> PathConj(path, j)) (fun _j -> inpAccess)) subPats + let newActives = List.mapi (mkSubActive (fun path _j -> path) (fun _j -> inpAccess)) subPats BindProjectionPatterns newActives activeState | TPat_range (c1, c2, m) -> diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 41b4922a7d0..b4d9acf83f9 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -85,9 +85,6 @@ type env = /// "module remap info", i.e. hiding information down the signature chain, used to compute what's hidden by a signature sigToImplRemapInfo: (Remap * SignatureHidingInfo) list - /// Constructor limited - are we in the prelude of a constructor, prior to object initialization - ctorLimitedZone: bool - /// Are we in a quotation? quote : bool @@ -1143,7 +1140,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (ctxt: PermitByRefExpr) : Limit = | Expr.Sequential (e1, e2, ThenDoSeq, _) -> CheckExprNoByrefs cenv env e1 - CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2 + CheckExprNoByrefs cenv env e2 NoLimit | Expr.Const (_, m, ty) -> @@ -1425,9 +1422,6 @@ and CheckNoResumableStmtConstructs cenv _env expr = and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr = let g = cenv.g - let ctorLimitedZoneCheck() = - if env.ctorLimitedZone then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m)) - // Ensure anonymous record type requirements are recorded match op with | TOp.AnonRecdGet (anonInfo, _) @@ -1444,7 +1438,6 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr = | TOp.TryFinally _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/finally can be a byref - ctorLimitedZoneCheck() let limit = CheckExpr cenv env e1 ctxt // result of a try/finally can be a byref if in a position where the overall expression is can be a byref CheckExprNoByrefs cenv env e2 limit @@ -1455,7 +1448,6 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr = | TOp.TryWith _, [_], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], _e2, _, _); Expr.Lambda (_, _, _, [_], e3, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/catch can be a byref - ctorLimitedZoneCheck() let limit1 = CheckExpr cenv env e1 ctxt // result of a try/catch can be a byref if in a position where the overall expression is can be a byref // [(* e2; -- don't check filter body - duplicates logic in 'catch' body *) e3] let limit2 = CheckExpr cenv env e3 ctxt // result of a try/catch can be a byref if in a position where the overall expression is can be a byref @@ -2010,8 +2002,6 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin let access = AdjustAccess (IsHiddenVal env.sigToImplRemapInfo v) (fun () -> v.DeclaringEntity.CompilationPath) v.Accessibility CheckTypeForAccess cenv env (fun () -> NicePrint.stringOfQualifiedValOrMember cenv.denv cenv.infoReader vref) access v.Range v.Type - let env = if v.IsConstructor && not v.IsIncrClassConstructor then { env with ctorLimitedZone=true } else env - if cenv.reportErrors then // Check top-level let-bound values @@ -2643,7 +2633,6 @@ let CheckImplFile (g, amap, reportErrors, infoReader, internalsVisibleToPaths, v let env = { sigToImplRemapInfo=[] quote=false - ctorLimitedZone=false boundTyparNames=[] argVals = ValMap.Empty boundTypars= TyparMap.Empty diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index cca134f4d38..03e13801249 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -584,7 +584,7 @@ let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod: ILModuleDef) let scoref = ILScopeRef.Assembly aref let mtypsForExportedTypes = ImportILAssemblyExportedTypes amap m auxModLoader scoref mainmod.ManifestOfAssembly.ExportedTypes let mainmod = ImportILAssemblyMainTypeDefs amap m scoref mainmod - CombineCcuContentFragments m (mainmod :: mtypsForExportedTypes) + CombineCcuContentFragments (mainmod :: mtypsForExportedTypes) /// Import the type forwarder table for an IL assembly let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders): CcuTypeForwarderTable = diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 1c0612eb611..68e844fa919 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -438,6 +438,11 @@ type ILTypeInfo = member x.IsValueType = x.RawMetadata.IsStructOrEnum + /// Indicates if the type is marked with the [] attribute. + member x.IsReadOnly (g: TcGlobals) = + x.RawMetadata.CustomAttrs + |> TryFindILAttribute g.attrib_IsReadOnlyAttribute + member x.Instantiate inst = let (ILTypeInfo(g, ty, tref, tdef)) = x ILTypeInfo(g, instType inst ty, tref, tdef) @@ -993,15 +998,22 @@ type MethInfo = member x.IsStruct = isStructTy x.TcGlobals x.ApparentEnclosingType - /// Indicates if this method is read-only; usually by the [] attribute. + member x.IsOnReadOnlyType = + let g = x.TcGlobals + let typeInfo = ILTypeInfo.FromType g x.ApparentEnclosingType + typeInfo.IsReadOnly g + + /// Indicates if this method is read-only; usually by the [] attribute on method or struct level. /// Must be an instance method. /// Receiver must be a struct type. member x.IsReadOnly = - // Perf Review: Is there a way we can cache this result? + // Perf Review: Is there a way we can cache this result? + x.IsInstance && x.IsStruct && match x with - | ILMeth (g, ilMethInfo, _) -> ilMethInfo.IsReadOnly g + | ILMeth (g, ilMethInfo, _) -> + ilMethInfo.IsReadOnly g || x.IsOnReadOnlyType | FSMeth _ -> false // F# defined methods not supported yet. Must be a language feature. | _ -> false @@ -2263,6 +2275,12 @@ type EventInfo = | ProvidedEvent (_, ei, _) -> ProvidedEventInfo.TaintedGetHashCode ei #endif override x.ToString() = "event " + x.EventName + + /// Get custom attributes for events (only applicable for IL events) + member x.GetCustomAttrs() = + match x with + | ILEvent(ILEventInfo(_, ilEventDef))-> ilEventDef.CustomAttrs + | _ -> ILAttributes.Empty //------------------------------------------------------------------------- // Helpers associated with getting and comparing method signatures diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index 63a24eb6502..550c7860b34 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -1009,6 +1009,9 @@ type EventInfo = /// Get the delegate type associated with the event. member GetDelegateType: amap: ImportMap * m: range -> TType + /// Get custom attributes for events (only applicable for IL events) + member GetCustomAttrs: unit -> ILAttributes + /// An exception type used to raise an error using the old error system. /// /// Error text: "A definition to be compiled as a .NET event does not have the expected form. Only property members can be compiled as .NET events." diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 4064cdd1896..1c3d18ffcd1 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2840,9 +2840,7 @@ let ComputeDebugPointForBinding g bind = | DebugPointAtBinding.NoneAtDo, _ -> false, None | DebugPointAtBinding.NoneAtLet, _ -> false, None // Don't emit debug points for lambdas. - | _, - (Expr.Lambda _ - | Expr.TyLambda _) -> false, None + | _, (Expr.Lambda _ | Expr.TyLambda _) -> false, None | DebugPointAtBinding.Yes m, _ -> false, Some m //------------------------------------------------------------------------- @@ -5134,21 +5132,10 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = // For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa) | ([ AI_ceq ], [ arg1 - Expr.Const ((Const.Bool false - | Const.SByte 0y - | Const.Int16 0s - | Const.Int32 0 - | Const.Int64 0L - | Const.Byte 0uy - | Const.UInt16 0us - | Const.UInt32 0u - | Const.UInt64 0UL), + Expr.Const ((Const.Bool false | Const.SByte 0y | Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy | Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL), _, _) ], - CmpThenBrOrContinue (1, - [ I_brcmp ((BI_brfalse - | BI_brtrue) as bi, - label1) ]), + CmpThenBrOrContinue (1, [ I_brcmp ((BI_brfalse | BI_brtrue) as bi, label1) ]), _) -> let bi = @@ -7903,9 +7890,7 @@ and GenDecisionTreeTest // If so, emit the failure logic, then came back and do the success target, then // do any postponed failure target. match successTree, failureTree with - | TDSuccess _, - (TDBind _ - | TDSwitch _) -> + | TDSuccess _, (TDBind _ | TDSwitch _) -> // OK, there is more logic in the decision tree on the failure branch let success = CG.GenerateDelayMark cgbuf "testSuccess" @@ -10641,10 +10626,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | None -> None | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with - | ("Item" - | "op_IndexedLookup"), - (SynMemberKind.PropertyGet - | SynMemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal g vref.Deref)) -> + | ("Item" | "op_IndexedLookup"), (SynMemberKind.PropertyGet | SynMemberKind.PropertySet) when + not (isNil (ArgInfosOfPropertyVal g vref.Deref)) + -> Some( mkILCustomAttribute ( g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute", @@ -11552,6 +11536,11 @@ let CodegenAssembly cenv eenv mgbuf implFiles = match List.tryFrontAndBack implFiles with | None -> () | Some (firstImplFiles, lastImplFile) -> + + // Generate the assembly sequentially, implementation file by implementation file. + // + // NOTE: In theory this could be done in parallel, except for the presence of linear + // state in the AssemblyBuilder let eenv = List.fold (GenImplFile cenv mgbuf None) eenv firstImplFiles let eenv = GenImplFile cenv mgbuf cenv.options.mainMethodInfo eenv lastImplFile @@ -11626,7 +11615,7 @@ type IlxGenResults = let GenerateCode (cenv, anonTypeTable, eenv, CheckedAssemblyAfterOptimization implFiles, assemAttribs, moduleAttribs) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.IlxGen + use _ = UseBuildPhase BuildPhase.IlxGen let g = cenv.g // Generate the implementations into the mgbuf diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 55ac85b9a3a..91a2e9fde3d 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -388,6 +388,11 @@ type MetadataAssemblyGeneration = | ReferenceOut of outputPath: string | ReferenceOnly +[] +type ParallelReferenceResolution = + | On + | Off + [] type TcConfigBuilder = { @@ -502,6 +507,7 @@ type TcConfigBuilder = mutable emitTailcalls: bool mutable deterministic: bool mutable concurrentBuild: bool + mutable parallelCheckingWithSignatureFiles: bool mutable emitMetadataAssembly: MetadataAssemblyGeneration mutable preferredUiLang: string option mutable lcid: int option @@ -579,6 +585,8 @@ type TcConfigBuilder = mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option mutable exiter: Exiter + + mutable parallelReferenceResolution: ParallelReferenceResolution } // Directories to start probing in @@ -725,6 +733,7 @@ type TcConfigBuilder = emitTailcalls = true deterministic = false concurrentBuild = true + parallelCheckingWithSignatureFiles = false emitMetadataAssembly = MetadataAssemblyGeneration.None preferredUiLang = None lcid = None @@ -765,6 +774,7 @@ type TcConfigBuilder = sdkDirOverride = sdkDirOverride xmlDocInfoLoader = None exiter = QuitProcessExiter + parallelReferenceResolution = ParallelReferenceResolution.Off } member tcConfigB.FxResolver = @@ -797,7 +807,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- None // this needs to be recreated when the primary assembly changes member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let paths = seq { @@ -809,7 +819,7 @@ type TcConfigBuilder = /// Decide names of output file, pdb and assembly member tcConfigB.DecideNames sourceFiles = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter if sourceFiles = [] then errorR (Error(FSComp.SR.buildNoInputsSpecified (), rangeCmdArgs)) @@ -860,7 +870,7 @@ type TcConfigBuilder = outfile, pdbfile, assemblyName member tcConfigB.TurnWarningOff(m, s: string) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -875,7 +885,7 @@ type TcConfigBuilder = } member tcConfigB.TurnWarningOn(m, s: string) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -1276,6 +1286,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.emitTailcalls = data.emitTailcalls member _.deterministic = data.deterministic member _.concurrentBuild = data.concurrentBuild + member _.parallelCheckingWithSignatureFiles = data.parallelCheckingWithSignatureFiles member _.emitMetadataAssembly = data.emitMetadataAssembly member _.pathMap = data.pathMap member _.langVersion = data.langVersion @@ -1307,9 +1318,10 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.applyLineDirectives = data.applyLineDirectives member _.xmlDocInfoLoader = data.xmlDocInfoLoader member _.exiter = data.exiter + member _.parallelReferenceResolution = data.parallelReferenceResolution static member Create(builder, validate) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter TcConfig(builder, validate) member _.legacyReferenceResolver = data.legacyReferenceResolver @@ -1326,7 +1338,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.GetTargetFrameworkDirectories() = targetFrameworkDirectories member tcConfig.ComputeIndentationAwareSyntaxInitialStatus fileName = - use _unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter let indentationAwareSyntaxOnByDefault = List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes @@ -1337,7 +1349,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = (tcConfig.indentationAwareSyntax = Some true) member tcConfig.GetAvailableLoadedSources() = - use _unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter let resolveLoadedSource (m, originalPath, path) = try @@ -1393,14 +1405,13 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = /// 'framework' reference set that is potentially shared across multiple compilations. member tcConfig.IsSystemAssembly(fileName: string) = try + let dirName = Path.GetDirectoryName fileName + let baseName = FileSystemUtils.fileNameWithoutExtension fileName + FileSystem.FileExistsShim fileName - && ((tcConfig.GetTargetFrameworkDirectories() - |> List.exists (fun clrRoot -> clrRoot = Path.GetDirectoryName fileName)) - || (tcConfig - .FxResolver - .GetSystemAssemblies() - .Contains(FileSystemUtils.fileNameWithoutExtension fileName)) - || tcConfig.FxResolver.IsInReferenceAssemblyPackDirectory fileName) + && ((tcConfig.GetTargetFrameworkDirectories() |> List.contains dirName) + || FxResolver.GetSystemAssemblies().Contains baseName + || FxResolver.IsReferenceAssemblyPackDirectoryApprox dirName) with _ -> false diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index e200fb03e02..70abf7beb63 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -198,6 +198,11 @@ type MetadataAssemblyGeneration = /// Only emits the assembly as a reference assembly. | ReferenceOnly +[] +type ParallelReferenceResolution = + | On + | Off + [] type TcConfigBuilder = { @@ -407,6 +412,8 @@ type TcConfigBuilder = mutable concurrentBuild: bool + mutable parallelCheckingWithSignatureFiles: bool + mutable emitMetadataAssembly: MetadataAssemblyGeneration mutable preferredUiLang: string option @@ -480,6 +487,8 @@ type TcConfigBuilder = mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option mutable exiter: Exiter + + mutable parallelReferenceResolution: ParallelReferenceResolution } static member CreateNew: @@ -723,6 +732,8 @@ type TcConfig = member concurrentBuild: bool + member parallelCheckingWithSignatureFiles: bool + member emitMetadataAssembly: MetadataAssemblyGeneration member pathMap: PathMap @@ -841,6 +852,8 @@ type TcConfig = member exiter: Exiter + member parallelReferenceResolution: ParallelReferenceResolution + /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. [] diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index a6e0450af3a..a2fd68372c7 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -42,9 +42,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps #if DEBUG -[] -module internal CompilerService = - let showAssertForUnexpectedException = ref true +let showAssertForUnexpectedException = ref true #endif /// This exception is an old-style way of reporting a diagnostic @@ -77,12 +75,13 @@ exception DeprecatedCommandLineOptionNoDescription of string * range /// This exception is an old-style way of reporting a diagnostic exception InternalCommandLineOption of string * range -let GetRangeOfDiagnostic (diagnostic: PhasedDiagnostic) = - let rec RangeFromException exn = +type Exception with + + member exn.DiagnosticRange = match exn with - | ErrorFromAddingConstraint (_, exn2, _) -> RangeFromException exn2 + | ErrorFromAddingConstraint (_, exn2, _) -> exn2.DiagnosticRange #if !NO_TYPEPROVIDERS - | TypeProviders.ProvidedTypeResolutionNoRange exn -> RangeFromException exn + | TypeProviders.ProvidedTypeResolutionNoRange exn -> exn.DiagnosticRange | TypeProviders.ProvidedTypeResolution (m, _) #endif | ReservedKeyword (_, m) @@ -203,17 +202,13 @@ let GetRangeOfDiagnostic (diagnostic: PhasedDiagnostic) = | HashLoadedSourceHasIssues (_, _, _, m) | HashLoadedScriptConsideredSource m -> Some m // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as e -> RangeFromException e.InnerException + | :? System.Reflection.TargetInvocationException as e -> e.InnerException.DiagnosticRange #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif - | _ -> None - RangeFromException diagnostic.Exception - -let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = - let rec GetFromException (exn: exn) = + member exn.DiagnosticNumber = match exn with // DO NOT CHANGE THESE NUMBERS | ErrorFromAddingTypeEquation _ -> 1 @@ -328,13 +323,10 @@ let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = | TypeProviders.ProvidedTypeResolution _ -> 103 #endif | PatternMatchCompilation.EnumMatchIncomplete _ -> 104 - // DO NOT CHANGE THE NUMBERS // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as e -> GetFromException e.InnerException - - | WrappedError (e, _) -> GetFromException e - + | :? TargetInvocationException as e -> e.InnerException.DiagnosticNumber + | WrappedError (e, _) -> e.DiagnosticNumber | DiagnosticWithText (n, _, _) -> n | DiagnosticWithSuggestions (n, _, _, _, _) -> n | Failure _ -> 192 @@ -346,275 +338,288 @@ let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = fst (FSComp.SR.considerUpcast ("", "")) | _ -> 193 - GetFromException diagnostic.Exception - -let GetWarningLevel diagnostic = - match diagnostic.Exception with - // Level 5 warnings - | RecursiveUseCheckedAtRuntime _ - | LetRecEvaluatedOutOfOrder _ - | DefensiveCopyWarning _ -> 5 - - | DiagnosticWithText (n, _, _) - | DiagnosticWithSuggestions (n, _, _, _, _) -> - // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..." - // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." - // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..." - // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...." - if (n = 1178) then 5 else 2 - // Level 2 - | _ -> 2 - -let IsWarningOrInfoEnabled (diagnostic, severity) n level specificWarnOn = - List.contains n specificWarnOn - || - // Some specific warnings/informational are never on by default, i.e. unused variable warnings - match n with - | 1182 -> false // chkUnusedValue - off by default - | 3180 -> false // abImplicitHeapAllocation - off by default - | 3186 -> false // pickleMissingDefinition - off by default - | 3366 -> false //tcIndexNotationDeprecated - currently off by default - | 3517 -> false // optFailedToInlineSuggestedValue - off by default - | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default - | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default - | 3390 -> false // xmlDocBadlyFormed - off by default - | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default - | _ -> - (severity = FSharpDiagnosticSeverity.Info) - || (severity = FSharpDiagnosticSeverity.Warning - && level >= GetWarningLevel diagnostic) +type PhasedDiagnostic with + + member x.Range = x.Exception.DiagnosticRange + + member x.Number = x.Exception.DiagnosticNumber + + member x.WarningLevel = + match x.Exception with + // Level 5 warnings + | RecursiveUseCheckedAtRuntime _ + | LetRecEvaluatedOutOfOrder _ + | DefensiveCopyWarning _ -> 5 + + | DiagnosticWithText (n, _, _) + | DiagnosticWithSuggestions (n, _, _, _, _) -> + // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..." + // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." + // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..." + // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...." + if (n = 1178) then 5 else 2 + // Level 2 + | _ -> 2 + + member x.IsEnabled(severity, options) = + let level = options.WarnLevel + let specificWarnOn = options.WarnOn + let n = x.Number + + List.contains n specificWarnOn + || + // Some specific warnings/informational are never on by default, i.e. unused variable warnings + match n with + | 1182 -> false // chkUnusedValue - off by default + | 3180 -> false // abImplicitHeapAllocation - off by default + | 3186 -> false // pickleMissingDefinition - off by default + | 3366 -> false //tcIndexNotationDeprecated - currently off by default + | 3517 -> false // optFailedToInlineSuggestedValue - off by default + | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default + | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default + | 3390 -> false // xmlDocBadlyFormed - off by default + | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default + | _ -> + (severity = FSharpDiagnosticSeverity.Info) + || (severity = FSharpDiagnosticSeverity.Warning && level >= x.WarningLevel) + + /// Indicates if a diagnostic should be reported as an informational + member x.ReportAsInfo(options, severity) = + match severity with + | FSharpDiagnosticSeverity.Error -> false + | FSharpDiagnosticSeverity.Warning -> false + | FSharpDiagnosticSeverity.Info -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff) + | FSharpDiagnosticSeverity.Hidden -> false + + /// Indicates if a diagnostic should be reported as a warning + member x.ReportAsWarning(options, severity) = + match severity with + | FSharpDiagnosticSeverity.Error -> false + + | FSharpDiagnosticSeverity.Warning -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff) + + // Informational become warning if explicitly on and not explicitly off + | FSharpDiagnosticSeverity.Info -> + let n = x.Number + List.contains n options.WarnOn && not (List.contains n options.WarnOff) + + | FSharpDiagnosticSeverity.Hidden -> false + + /// Indicates if a diagnostic should be reported as an error + member x.ReportAsError(options, severity) = + + match severity with + | FSharpDiagnosticSeverity.Error -> true + + // Warnings become errors in some situations + | FSharpDiagnosticSeverity.Warning -> + let n = x.Number + + x.IsEnabled(severity, options) + && not (List.contains n options.WarnAsWarn) + && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff)) + || List.contains n options.WarnAsError) + + // Informational become errors if explicitly WarnAsError + | FSharpDiagnosticSeverity.Info -> List.contains x.Number options.WarnAsError + + | FSharpDiagnosticSeverity.Hidden -> false -let SplitRelatedDiagnostics (diagnostic: PhasedDiagnostic) : PhasedDiagnostic * PhasedDiagnostic list = - let ToPhased exn = - { - Exception = exn - Phase = diagnostic.Phase - } - - let rec SplitRelatedException exn = - match exn with - | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) |> ToPhased, related - | ErrorFromApplyingDefault (g, denv, tp, defaultType, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - - ErrorFromApplyingDefault(g, denv, tp, defaultType, diag2.Exception, m) - |> ToPhased, - related - | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, exn2, contextInfo, m) -> - let diag2, related = SplitRelatedException exn2 - - ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, diag2.Exception, contextInfo, m) - |> ToPhased, - related - | ErrorFromAddingConstraint (x, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - ErrorFromAddingConstraint(x, diag2.Exception, m) |> ToPhased, related - | WrappedError (exn2, m) -> - let diag2, related = SplitRelatedException exn2 - WrappedError(diag2.Exception, m) |> ToPhased, related - // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> SplitRelatedException exn.InnerException - | _ -> ToPhased exn, [] - - SplitRelatedException diagnostic.Exception - -let Message (name, format) = DeclareResourceString(name, format) - -do FSComp.SR.RunStartupValidation() -let SeeAlsoE () = Message("SeeAlso", "%s") -let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") -let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") -let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") -let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") -let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") -let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") -let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") -let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") -let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") -let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") -let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") -let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") -let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") -let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") -let FunctionExpectedE () = Message("FunctionExpected", "") -let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") -let BadEventTransformationE () = Message("BadEventTransformation", "") -let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") -let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") -let TyconBadArgsE () = Message("TyconBadArgs", "%s%d%d") -let IndeterminateTypeE () = Message("IndeterminateType", "") -let NameClash1E () = Message("NameClash1", "%s%s") -let NameClash2E () = Message("NameClash2", "%s%s%s%s%s") -let Duplicate1E () = Message("Duplicate1", "%s") -let Duplicate2E () = Message("Duplicate2", "%s%s") -let UndefinedName2E () = Message("UndefinedName2", "") -let FieldNotMutableE () = Message("FieldNotMutable", "") -let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") -let VarBoundTwiceE () = Message("VarBoundTwice", "%s") -let RecursionE () = Message("Recursion", "%s%s%s%s") -let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") -let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") -let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") -let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") -let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") -let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") -let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") -let NonRigidTypar3E () = Message("NonRigidTypar3", "%s%s") -let OBlockEndSentenceE () = Message("BlockEndSentence", "") -let UnexpectedEndOfInputE () = Message("UnexpectedEndOfInput", "") -let UnexpectedE () = Message("Unexpected", "%s") -let NONTERM_interactionE () = Message("NONTERM.interaction", "") -let NONTERM_hashDirectiveE () = Message("NONTERM.hashDirective", "") -let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") -let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") -let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") -let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") -let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") -let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") -let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") -let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") -let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") -let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") -let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") -let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") -let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") -let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") -let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") -let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") -let NONTERM_patternClausesE () = Message("NONTERM.patternClauses", "") -let NONTERM_beginEndExprE () = Message("NONTERM.beginEndExpr", "") -let NONTERM_recdExprE () = Message("NONTERM.recdExpr", "") -let NONTERM_tyconDefnE () = Message("NONTERM.tyconDefn", "") -let NONTERM_exconCoreE () = Message("NONTERM.exconCore", "") -let NONTERM_typeNameInfoE () = Message("NONTERM.typeNameInfo", "") -let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") -let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") -let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") -let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") -let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") -let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") -let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") -let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") -let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") -let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") -let TokenName1E () = Message("TokenName1", "%s") -let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") -let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") -let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") -let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") -let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") -let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") -let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") -let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") -let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") -let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") -let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") -let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") -let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") -let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") -let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") -let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") -let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") -let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") -let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") -let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") -let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") -let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") -let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") -let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") -let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") -let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") -let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") -let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") -let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") -let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") -let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") -let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") -let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") -let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") -let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") -let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") -let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") -let Failure3E () = Message("Failure3", "%s") -let Failure4E () = Message("Failure4", "%s") -let MatchIncomplete1E () = Message("MatchIncomplete1", "") -let MatchIncomplete2E () = Message("MatchIncomplete2", "%s") -let MatchIncomplete3E () = Message("MatchIncomplete3", "%s") -let MatchIncomplete4E () = Message("MatchIncomplete4", "") -let RuleNeverMatchedE () = Message("RuleNeverMatched", "") -let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "") -let ValNotMutableE () = Message("ValNotMutable", "%s") -let ValNotLocalE () = Message("ValNotLocal", "") -let Obsolete1E () = Message("Obsolete1", "") -let Obsolete2E () = Message("Obsolete2", "%s") -let ExperimentalE () = Message("Experimental", "%s") -let PossibleUnverifiableCodeE () = Message("PossibleUnverifiableCode", "") -let DeprecatedE () = Message("Deprecated", "%s") -let LibraryUseOnlyE () = Message("LibraryUseOnly", "") -let MissingFieldsE () = Message("MissingFields", "%s") -let ValueRestriction1E () = Message("ValueRestriction1", "%s%s%s") -let ValueRestriction2E () = Message("ValueRestriction2", "%s%s%s") -let ValueRestriction3E () = Message("ValueRestriction3", "%s") -let ValueRestriction4E () = Message("ValueRestriction4", "%s%s%s") -let ValueRestriction5E () = Message("ValueRestriction5", "%s%s%s") -let RecoverableParseErrorE () = Message("RecoverableParseError", "") -let ReservedKeywordE () = Message("ReservedKeyword", "%s") -let IndentationProblemE () = Message("IndentationProblem", "%s") -let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") -let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") -let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") -let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") -let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") -let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") -let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") -let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") -let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") -let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") -let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") -let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") -let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") -let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") -let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") -let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") -let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") -let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") -let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") -let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") +[] +module OldStyleMessages = + let Message (name, format) = DeclareResourceString(name, format) + + do FSComp.SR.RunStartupValidation() + let SeeAlsoE () = Message("SeeAlso", "%s") + let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") + let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") + let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") + let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") + let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") + let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") + let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") + let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") + let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") + let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") + let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") + let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") + let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") + let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") + let FunctionExpectedE () = Message("FunctionExpected", "") + let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") + let BadEventTransformationE () = Message("BadEventTransformation", "") + let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") + let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") + let TyconBadArgsE () = Message("TyconBadArgs", "%s%d%d") + let IndeterminateTypeE () = Message("IndeterminateType", "") + let NameClash1E () = Message("NameClash1", "%s%s") + let NameClash2E () = Message("NameClash2", "%s%s%s%s%s") + let Duplicate1E () = Message("Duplicate1", "%s") + let Duplicate2E () = Message("Duplicate2", "%s%s") + let UndefinedName2E () = Message("UndefinedName2", "") + let FieldNotMutableE () = Message("FieldNotMutable", "") + let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") + let VarBoundTwiceE () = Message("VarBoundTwice", "%s") + let RecursionE () = Message("Recursion", "%s%s%s%s") + let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") + let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") + let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") + let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") + let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") + let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") + let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") + let NonRigidTypar3E () = Message("NonRigidTypar3", "%s%s") + let OBlockEndSentenceE () = Message("BlockEndSentence", "") + let UnexpectedEndOfInputE () = Message("UnexpectedEndOfInput", "") + let UnexpectedE () = Message("Unexpected", "%s") + let NONTERM_interactionE () = Message("NONTERM.interaction", "") + let NONTERM_hashDirectiveE () = Message("NONTERM.hashDirective", "") + let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") + let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") + let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") + let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") + let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") + let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") + let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") + let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") + let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") + let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") + let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") + let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") + let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") + let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") + let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") + let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") + let NONTERM_patternClausesE () = Message("NONTERM.patternClauses", "") + let NONTERM_beginEndExprE () = Message("NONTERM.beginEndExpr", "") + let NONTERM_recdExprE () = Message("NONTERM.recdExpr", "") + let NONTERM_tyconDefnE () = Message("NONTERM.tyconDefn", "") + let NONTERM_exconCoreE () = Message("NONTERM.exconCore", "") + let NONTERM_typeNameInfoE () = Message("NONTERM.typeNameInfo", "") + let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") + let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") + let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") + let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") + let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") + let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") + let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") + let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") + let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") + let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") + let TokenName1E () = Message("TokenName1", "%s") + let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") + let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") + let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") + let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") + let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") + let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") + let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") + let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") + let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") + let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") + let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") + let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") + let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") + let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") + let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") + let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") + let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") + let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") + let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") + let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") + let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") + let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") + let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") + let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") + let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") + let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") + let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") + let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") + let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") + let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") + let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") + let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") + let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") + let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") + let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") + let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") + let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") + let Failure3E () = Message("Failure3", "%s") + let Failure4E () = Message("Failure4", "%s") + let MatchIncomplete1E () = Message("MatchIncomplete1", "") + let MatchIncomplete2E () = Message("MatchIncomplete2", "%s") + let MatchIncomplete3E () = Message("MatchIncomplete3", "%s") + let MatchIncomplete4E () = Message("MatchIncomplete4", "") + let RuleNeverMatchedE () = Message("RuleNeverMatched", "") + let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "") + let ValNotMutableE () = Message("ValNotMutable", "%s") + let ValNotLocalE () = Message("ValNotLocal", "") + let Obsolete1E () = Message("Obsolete1", "") + let Obsolete2E () = Message("Obsolete2", "%s") + let ExperimentalE () = Message("Experimental", "%s") + let PossibleUnverifiableCodeE () = Message("PossibleUnverifiableCode", "") + let DeprecatedE () = Message("Deprecated", "%s") + let LibraryUseOnlyE () = Message("LibraryUseOnly", "") + let MissingFieldsE () = Message("MissingFields", "%s") + let ValueRestriction1E () = Message("ValueRestriction1", "%s%s%s") + let ValueRestriction2E () = Message("ValueRestriction2", "%s%s%s") + let ValueRestriction3E () = Message("ValueRestriction3", "%s") + let ValueRestriction4E () = Message("ValueRestriction4", "%s%s%s") + let ValueRestriction5E () = Message("ValueRestriction5", "%s%s%s") + let RecoverableParseErrorE () = Message("RecoverableParseError", "") + let ReservedKeywordE () = Message("ReservedKeyword", "%s") + let IndentationProblemE () = Message("IndentationProblem", "%s") + let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") + let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") + let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") + let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") + let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") + let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") + let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") + let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") + let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") + let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") + let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") + let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") + let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") + let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") + let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") + let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") + let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") + let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") + let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") + let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") #if DEBUG let mutable showParserStackOnParseError = false #endif -let getErrorString key = SR.GetString key - let (|InvalidArgument|_|) (exn: exn) = match exn with | :? ArgumentException as e -> Some e.Message | _ -> None -let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSuggestNames: bool) = +let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText = + if suggestNames then + let buffer = DiagnosticResolutionHints.SuggestionBuffer idText - let suggestNames suggestionsF idText = - if canSuggestNames then - let buffer = DiagnosticResolutionHints.SuggestionBuffer idText + if not buffer.Disabled then + suggestionsF buffer.Add - if not buffer.Disabled then - suggestionsF buffer.Add + if not buffer.IsEmpty then + os.AppendString " " + os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ()) - if not buffer.IsEmpty then - os.AppendString " " - os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ()) + for value in buffer do + os.AppendLine() |> ignore + os.AppendString " " + os.AppendString(ConvertValLogicalNameToDisplayNameCore value) - for value in buffer do - os.AppendLine() |> ignore - os.AppendString " " - os.AppendString(ConvertValLogicalNameToDisplayNameCore value) +type Exception with - let rec OutputExceptionR (os: StringBuilder) error = + member exn.Output(os: StringBuilder, suggestNames) = - match error with + match exn with | ConstraintSolverTupleDiffLengths (_, tl1, tl2, m, m2) -> os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length) @@ -725,15 +730,11 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | ContextInfo.NoContext -> false | _ -> true) -> - OutputExceptionR os e + e.Output(os, suggestNames) - | ErrorFromAddingTypeEquation (_, - _, - _, - _, - (ConstraintSolverTypesNotInSubsumptionRelation _ - | ConstraintSolverError _ as e), - _) -> OutputExceptionR os e + | ErrorFromAddingTypeEquation(error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> e.Output(os, suggestNames) + + | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames) | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then @@ -742,12 +743,12 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquation2E().Format ty1 ty2 tpcs) - OutputExceptionR os e + e.Output(os, suggestNames) | ErrorFromApplyingDefault (_, denv, _, defaultType, e, _) -> let defaultType = NicePrint.minimalStringOfType denv defaultType os.AppendString(ErrorFromApplyingDefault1E().Format defaultType) - OutputExceptionR os e + e.Output(os, suggestNames) os.AppendString(ErrorFromApplyingDefault2E().Format) | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, e, contextInfo, _) -> @@ -766,9 +767,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu if ty1 <> (ty2 + tpcs) then os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs) else - OutputExceptionR os e + e.Output(os, suggestNames) else - OutputExceptionR os e + e.Output(os, suggestNames) | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format) @@ -776,12 +777,12 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format) - | ErrorFromAddingConstraint (_, e, _) -> OutputExceptionR os e + | ErrorFromAddingConstraint (_, e, _) -> e.Output(os, suggestNames) #if !NO_TYPEPROVIDERS | TypeProviders.ProvidedTypeResolutionNoRange e - | TypeProviders.ProvidedTypeResolution (_, e) -> OutputExceptionR os e + | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output(os, suggestNames) | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage) #endif @@ -944,7 +945,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | UndefinedName (_, k, id, suggestionsF) -> os.AppendString(k (ConvertValLogicalNameToDisplayNameCore id.idText)) - suggestNames suggestionsF id.idText + OutputNameSuggestions os suggestNames suggestionsF id.idText | InternalUndefinedItemRef (f, smr, ccuName, s) -> let _, errs = f (smr, ccuName, s) @@ -1008,7 +1009,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu let tokenIdToText tid = match tid with - | Parser.TOKEN_IDENT -> getErrorString ("Parser.TOKEN.IDENT") + | Parser.TOKEN_IDENT -> SR.GetString("Parser.TOKEN.IDENT") | Parser.TOKEN_BIGNUM | Parser.TOKEN_INT8 | Parser.TOKEN_UINT8 @@ -1019,191 +1020,191 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | Parser.TOKEN_INT64 | Parser.TOKEN_UINT64 | Parser.TOKEN_UNATIVEINT - | Parser.TOKEN_NATIVEINT -> getErrorString ("Parser.TOKEN.INT") + | Parser.TOKEN_NATIVEINT -> SR.GetString("Parser.TOKEN.INT") | Parser.TOKEN_IEEE32 - | Parser.TOKEN_IEEE64 -> getErrorString ("Parser.TOKEN.FLOAT") - | Parser.TOKEN_DECIMAL -> getErrorString ("Parser.TOKEN.DECIMAL") - | Parser.TOKEN_CHAR -> getErrorString ("Parser.TOKEN.CHAR") - - | Parser.TOKEN_BASE -> getErrorString ("Parser.TOKEN.BASE") - | Parser.TOKEN_LPAREN_STAR_RPAREN -> getErrorString ("Parser.TOKEN.LPAREN.STAR.RPAREN") - | Parser.TOKEN_DOLLAR -> getErrorString ("Parser.TOKEN.DOLLAR") - | Parser.TOKEN_INFIX_STAR_STAR_OP -> getErrorString ("Parser.TOKEN.INFIX.STAR.STAR.OP") - | Parser.TOKEN_INFIX_COMPARE_OP -> getErrorString ("Parser.TOKEN.INFIX.COMPARE.OP") - | Parser.TOKEN_COLON_GREATER -> getErrorString ("Parser.TOKEN.COLON.GREATER") - | Parser.TOKEN_COLON_COLON -> getErrorString ("Parser.TOKEN.COLON.COLON") - | Parser.TOKEN_PERCENT_OP -> getErrorString ("Parser.TOKEN.PERCENT.OP") - | Parser.TOKEN_INFIX_AT_HAT_OP -> getErrorString ("Parser.TOKEN.INFIX.AT.HAT.OP") - | Parser.TOKEN_INFIX_BAR_OP -> getErrorString ("Parser.TOKEN.INFIX.BAR.OP") - | Parser.TOKEN_PLUS_MINUS_OP -> getErrorString ("Parser.TOKEN.PLUS.MINUS.OP") - | Parser.TOKEN_PREFIX_OP -> getErrorString ("Parser.TOKEN.PREFIX.OP") - | Parser.TOKEN_COLON_QMARK_GREATER -> getErrorString ("Parser.TOKEN.COLON.QMARK.GREATER") - | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> getErrorString ("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") - | Parser.TOKEN_INFIX_AMP_OP -> getErrorString ("Parser.TOKEN.INFIX.AMP.OP") - | Parser.TOKEN_AMP -> getErrorString ("Parser.TOKEN.AMP") - | Parser.TOKEN_AMP_AMP -> getErrorString ("Parser.TOKEN.AMP.AMP") - | Parser.TOKEN_BAR_BAR -> getErrorString ("Parser.TOKEN.BAR.BAR") - | Parser.TOKEN_LESS -> getErrorString ("Parser.TOKEN.LESS") - | Parser.TOKEN_GREATER -> getErrorString ("Parser.TOKEN.GREATER") - | Parser.TOKEN_QMARK -> getErrorString ("Parser.TOKEN.QMARK") - | Parser.TOKEN_QMARK_QMARK -> getErrorString ("Parser.TOKEN.QMARK.QMARK") - | Parser.TOKEN_COLON_QMARK -> getErrorString ("Parser.TOKEN.COLON.QMARK") - | Parser.TOKEN_INT32_DOT_DOT -> getErrorString ("Parser.TOKEN.INT32.DOT.DOT") - | Parser.TOKEN_DOT_DOT -> getErrorString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_DOT_DOT_HAT -> getErrorString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_QUOTE -> getErrorString ("Parser.TOKEN.QUOTE") - | Parser.TOKEN_STAR -> getErrorString ("Parser.TOKEN.STAR") - | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") - | Parser.TOKEN_COLON -> getErrorString ("Parser.TOKEN.COLON") - | Parser.TOKEN_COLON_EQUALS -> getErrorString ("Parser.TOKEN.COLON.EQUALS") - | Parser.TOKEN_LARROW -> getErrorString ("Parser.TOKEN.LARROW") - | Parser.TOKEN_EQUALS -> getErrorString ("Parser.TOKEN.EQUALS") - | Parser.TOKEN_GREATER_BAR_RBRACK -> getErrorString ("Parser.TOKEN.GREATER.BAR.RBRACK") - | Parser.TOKEN_MINUS -> getErrorString ("Parser.TOKEN.MINUS") - | Parser.TOKEN_ADJACENT_PREFIX_OP -> getErrorString ("Parser.TOKEN.ADJACENT.PREFIX.OP") - | Parser.TOKEN_FUNKY_OPERATOR_NAME -> getErrorString ("Parser.TOKEN.FUNKY.OPERATOR.NAME") - | Parser.TOKEN_COMMA -> getErrorString ("Parser.TOKEN.COMMA") - | Parser.TOKEN_DOT -> getErrorString ("Parser.TOKEN.DOT") - | Parser.TOKEN_BAR -> getErrorString ("Parser.TOKEN.BAR") - | Parser.TOKEN_HASH -> getErrorString ("Parser.TOKEN.HASH") - | Parser.TOKEN_UNDERSCORE -> getErrorString ("Parser.TOKEN.UNDERSCORE") - | Parser.TOKEN_SEMICOLON -> getErrorString ("Parser.TOKEN.SEMICOLON") - | Parser.TOKEN_SEMICOLON_SEMICOLON -> getErrorString ("Parser.TOKEN.SEMICOLON.SEMICOLON") - | Parser.TOKEN_LPAREN -> getErrorString ("Parser.TOKEN.LPAREN") + | Parser.TOKEN_IEEE64 -> SR.GetString("Parser.TOKEN.FLOAT") + | Parser.TOKEN_DECIMAL -> SR.GetString("Parser.TOKEN.DECIMAL") + | Parser.TOKEN_CHAR -> SR.GetString("Parser.TOKEN.CHAR") + + | Parser.TOKEN_BASE -> SR.GetString("Parser.TOKEN.BASE") + | Parser.TOKEN_LPAREN_STAR_RPAREN -> SR.GetString("Parser.TOKEN.LPAREN.STAR.RPAREN") + | Parser.TOKEN_DOLLAR -> SR.GetString("Parser.TOKEN.DOLLAR") + | Parser.TOKEN_INFIX_STAR_STAR_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.STAR.OP") + | Parser.TOKEN_INFIX_COMPARE_OP -> SR.GetString("Parser.TOKEN.INFIX.COMPARE.OP") + | Parser.TOKEN_COLON_GREATER -> SR.GetString("Parser.TOKEN.COLON.GREATER") + | Parser.TOKEN_COLON_COLON -> SR.GetString("Parser.TOKEN.COLON.COLON") + | Parser.TOKEN_PERCENT_OP -> SR.GetString("Parser.TOKEN.PERCENT.OP") + | Parser.TOKEN_INFIX_AT_HAT_OP -> SR.GetString("Parser.TOKEN.INFIX.AT.HAT.OP") + | Parser.TOKEN_INFIX_BAR_OP -> SR.GetString("Parser.TOKEN.INFIX.BAR.OP") + | Parser.TOKEN_PLUS_MINUS_OP -> SR.GetString("Parser.TOKEN.PLUS.MINUS.OP") + | Parser.TOKEN_PREFIX_OP -> SR.GetString("Parser.TOKEN.PREFIX.OP") + | Parser.TOKEN_COLON_QMARK_GREATER -> SR.GetString("Parser.TOKEN.COLON.QMARK.GREATER") + | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") + | Parser.TOKEN_INFIX_AMP_OP -> SR.GetString("Parser.TOKEN.INFIX.AMP.OP") + | Parser.TOKEN_AMP -> SR.GetString("Parser.TOKEN.AMP") + | Parser.TOKEN_AMP_AMP -> SR.GetString("Parser.TOKEN.AMP.AMP") + | Parser.TOKEN_BAR_BAR -> SR.GetString("Parser.TOKEN.BAR.BAR") + | Parser.TOKEN_LESS -> SR.GetString("Parser.TOKEN.LESS") + | Parser.TOKEN_GREATER -> SR.GetString("Parser.TOKEN.GREATER") + | Parser.TOKEN_QMARK -> SR.GetString("Parser.TOKEN.QMARK") + | Parser.TOKEN_QMARK_QMARK -> SR.GetString("Parser.TOKEN.QMARK.QMARK") + | Parser.TOKEN_COLON_QMARK -> SR.GetString("Parser.TOKEN.COLON.QMARK") + | Parser.TOKEN_INT32_DOT_DOT -> SR.GetString("Parser.TOKEN.INT32.DOT.DOT") + | Parser.TOKEN_DOT_DOT -> SR.GetString("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_DOT_DOT_HAT -> SR.GetString("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_QUOTE -> SR.GetString("Parser.TOKEN.QUOTE") + | Parser.TOKEN_STAR -> SR.GetString("Parser.TOKEN.STAR") + | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") + | Parser.TOKEN_COLON -> SR.GetString("Parser.TOKEN.COLON") + | Parser.TOKEN_COLON_EQUALS -> SR.GetString("Parser.TOKEN.COLON.EQUALS") + | Parser.TOKEN_LARROW -> SR.GetString("Parser.TOKEN.LARROW") + | Parser.TOKEN_EQUALS -> SR.GetString("Parser.TOKEN.EQUALS") + | Parser.TOKEN_GREATER_BAR_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.BAR.RBRACK") + | Parser.TOKEN_MINUS -> SR.GetString("Parser.TOKEN.MINUS") + | Parser.TOKEN_ADJACENT_PREFIX_OP -> SR.GetString("Parser.TOKEN.ADJACENT.PREFIX.OP") + | Parser.TOKEN_FUNKY_OPERATOR_NAME -> SR.GetString("Parser.TOKEN.FUNKY.OPERATOR.NAME") + | Parser.TOKEN_COMMA -> SR.GetString("Parser.TOKEN.COMMA") + | Parser.TOKEN_DOT -> SR.GetString("Parser.TOKEN.DOT") + | Parser.TOKEN_BAR -> SR.GetString("Parser.TOKEN.BAR") + | Parser.TOKEN_HASH -> SR.GetString("Parser.TOKEN.HASH") + | Parser.TOKEN_UNDERSCORE -> SR.GetString("Parser.TOKEN.UNDERSCORE") + | Parser.TOKEN_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON") + | Parser.TOKEN_SEMICOLON_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON.SEMICOLON") + | Parser.TOKEN_LPAREN -> SR.GetString("Parser.TOKEN.LPAREN") | Parser.TOKEN_RPAREN | Parser.TOKEN_RPAREN_COMING_SOON - | Parser.TOKEN_RPAREN_IS_HERE -> getErrorString ("Parser.TOKEN.RPAREN") - | Parser.TOKEN_LQUOTE -> getErrorString ("Parser.TOKEN.LQUOTE") - | Parser.TOKEN_LBRACK -> getErrorString ("Parser.TOKEN.LBRACK") - | Parser.TOKEN_LBRACE_BAR -> getErrorString ("Parser.TOKEN.LBRACE.BAR") - | Parser.TOKEN_LBRACK_BAR -> getErrorString ("Parser.TOKEN.LBRACK.BAR") - | Parser.TOKEN_LBRACK_LESS -> getErrorString ("Parser.TOKEN.LBRACK.LESS") - | Parser.TOKEN_LBRACE -> getErrorString ("Parser.TOKEN.LBRACE") - | Parser.TOKEN_BAR_RBRACK -> getErrorString ("Parser.TOKEN.BAR.RBRACK") - | Parser.TOKEN_BAR_RBRACE -> getErrorString ("Parser.TOKEN.BAR.RBRACE") - | Parser.TOKEN_GREATER_RBRACK -> getErrorString ("Parser.TOKEN.GREATER.RBRACK") + | Parser.TOKEN_RPAREN_IS_HERE -> SR.GetString("Parser.TOKEN.RPAREN") + | Parser.TOKEN_LQUOTE -> SR.GetString("Parser.TOKEN.LQUOTE") + | Parser.TOKEN_LBRACK -> SR.GetString("Parser.TOKEN.LBRACK") + | Parser.TOKEN_LBRACE_BAR -> SR.GetString("Parser.TOKEN.LBRACE.BAR") + | Parser.TOKEN_LBRACK_BAR -> SR.GetString("Parser.TOKEN.LBRACK.BAR") + | Parser.TOKEN_LBRACK_LESS -> SR.GetString("Parser.TOKEN.LBRACK.LESS") + | Parser.TOKEN_LBRACE -> SR.GetString("Parser.TOKEN.LBRACE") + | Parser.TOKEN_BAR_RBRACK -> SR.GetString("Parser.TOKEN.BAR.RBRACK") + | Parser.TOKEN_BAR_RBRACE -> SR.GetString("Parser.TOKEN.BAR.RBRACE") + | Parser.TOKEN_GREATER_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.RBRACK") | Parser.TOKEN_RQUOTE_DOT _ - | Parser.TOKEN_RQUOTE -> getErrorString ("Parser.TOKEN.RQUOTE") - | Parser.TOKEN_RBRACK -> getErrorString ("Parser.TOKEN.RBRACK") + | Parser.TOKEN_RQUOTE -> SR.GetString("Parser.TOKEN.RQUOTE") + | Parser.TOKEN_RBRACK -> SR.GetString("Parser.TOKEN.RBRACK") | Parser.TOKEN_RBRACE | Parser.TOKEN_RBRACE_COMING_SOON - | Parser.TOKEN_RBRACE_IS_HERE -> getErrorString ("Parser.TOKEN.RBRACE") - | Parser.TOKEN_PUBLIC -> getErrorString ("Parser.TOKEN.PUBLIC") - | Parser.TOKEN_PRIVATE -> getErrorString ("Parser.TOKEN.PRIVATE") - | Parser.TOKEN_INTERNAL -> getErrorString ("Parser.TOKEN.INTERNAL") - | Parser.TOKEN_CONSTRAINT -> getErrorString ("Parser.TOKEN.CONSTRAINT") - | Parser.TOKEN_INSTANCE -> getErrorString ("Parser.TOKEN.INSTANCE") - | Parser.TOKEN_DELEGATE -> getErrorString ("Parser.TOKEN.DELEGATE") - | Parser.TOKEN_INHERIT -> getErrorString ("Parser.TOKEN.INHERIT") - | Parser.TOKEN_CONSTRUCTOR -> getErrorString ("Parser.TOKEN.CONSTRUCTOR") - | Parser.TOKEN_DEFAULT -> getErrorString ("Parser.TOKEN.DEFAULT") - | Parser.TOKEN_OVERRIDE -> getErrorString ("Parser.TOKEN.OVERRIDE") - | Parser.TOKEN_ABSTRACT -> getErrorString ("Parser.TOKEN.ABSTRACT") - | Parser.TOKEN_CLASS -> getErrorString ("Parser.TOKEN.CLASS") - | Parser.TOKEN_MEMBER -> getErrorString ("Parser.TOKEN.MEMBER") - | Parser.TOKEN_STATIC -> getErrorString ("Parser.TOKEN.STATIC") - | Parser.TOKEN_NAMESPACE -> getErrorString ("Parser.TOKEN.NAMESPACE") - | Parser.TOKEN_OBLOCKBEGIN -> getErrorString ("Parser.TOKEN.OBLOCKBEGIN") - | EndOfStructuredConstructToken -> getErrorString ("Parser.TOKEN.OBLOCKEND") + | Parser.TOKEN_RBRACE_IS_HERE -> SR.GetString("Parser.TOKEN.RBRACE") + | Parser.TOKEN_PUBLIC -> SR.GetString("Parser.TOKEN.PUBLIC") + | Parser.TOKEN_PRIVATE -> SR.GetString("Parser.TOKEN.PRIVATE") + | Parser.TOKEN_INTERNAL -> SR.GetString("Parser.TOKEN.INTERNAL") + | Parser.TOKEN_CONSTRAINT -> SR.GetString("Parser.TOKEN.CONSTRAINT") + | Parser.TOKEN_INSTANCE -> SR.GetString("Parser.TOKEN.INSTANCE") + | Parser.TOKEN_DELEGATE -> SR.GetString("Parser.TOKEN.DELEGATE") + | Parser.TOKEN_INHERIT -> SR.GetString("Parser.TOKEN.INHERIT") + | Parser.TOKEN_CONSTRUCTOR -> SR.GetString("Parser.TOKEN.CONSTRUCTOR") + | Parser.TOKEN_DEFAULT -> SR.GetString("Parser.TOKEN.DEFAULT") + | Parser.TOKEN_OVERRIDE -> SR.GetString("Parser.TOKEN.OVERRIDE") + | Parser.TOKEN_ABSTRACT -> SR.GetString("Parser.TOKEN.ABSTRACT") + | Parser.TOKEN_CLASS -> SR.GetString("Parser.TOKEN.CLASS") + | Parser.TOKEN_MEMBER -> SR.GetString("Parser.TOKEN.MEMBER") + | Parser.TOKEN_STATIC -> SR.GetString("Parser.TOKEN.STATIC") + | Parser.TOKEN_NAMESPACE -> SR.GetString("Parser.TOKEN.NAMESPACE") + | Parser.TOKEN_OBLOCKBEGIN -> SR.GetString("Parser.TOKEN.OBLOCKBEGIN") + | EndOfStructuredConstructToken -> SR.GetString("Parser.TOKEN.OBLOCKEND") | Parser.TOKEN_THEN - | Parser.TOKEN_OTHEN -> getErrorString ("Parser.TOKEN.OTHEN") + | Parser.TOKEN_OTHEN -> SR.GetString("Parser.TOKEN.OTHEN") | Parser.TOKEN_ELSE - | Parser.TOKEN_OELSE -> getErrorString ("Parser.TOKEN.OELSE") + | Parser.TOKEN_OELSE -> SR.GetString("Parser.TOKEN.OELSE") | Parser.TOKEN_LET _ - | Parser.TOKEN_OLET _ -> getErrorString ("Parser.TOKEN.OLET") + | Parser.TOKEN_OLET _ -> SR.GetString("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER - | Parser.TOKEN_BINDER -> getErrorString ("Parser.TOKEN.BINDER") + | Parser.TOKEN_BINDER -> SR.GetString("Parser.TOKEN.BINDER") | Parser.TOKEN_OAND_BANG - | Parser.TOKEN_AND_BANG -> getErrorString ("Parser.TOKEN.AND.BANG") - | Parser.TOKEN_ODO -> getErrorString ("Parser.TOKEN.ODO") - | Parser.TOKEN_OWITH -> getErrorString ("Parser.TOKEN.OWITH") - | Parser.TOKEN_OFUNCTION -> getErrorString ("Parser.TOKEN.OFUNCTION") - | Parser.TOKEN_OFUN -> getErrorString ("Parser.TOKEN.OFUN") - | Parser.TOKEN_ORESET -> getErrorString ("Parser.TOKEN.ORESET") - | Parser.TOKEN_ODUMMY -> getErrorString ("Parser.TOKEN.ODUMMY") + | Parser.TOKEN_AND_BANG -> SR.GetString("Parser.TOKEN.AND.BANG") + | Parser.TOKEN_ODO -> SR.GetString("Parser.TOKEN.ODO") + | Parser.TOKEN_OWITH -> SR.GetString("Parser.TOKEN.OWITH") + | Parser.TOKEN_OFUNCTION -> SR.GetString("Parser.TOKEN.OFUNCTION") + | Parser.TOKEN_OFUN -> SR.GetString("Parser.TOKEN.OFUN") + | Parser.TOKEN_ORESET -> SR.GetString("Parser.TOKEN.ORESET") + | Parser.TOKEN_ODUMMY -> SR.GetString("Parser.TOKEN.ODUMMY") | Parser.TOKEN_DO_BANG - | Parser.TOKEN_ODO_BANG -> getErrorString ("Parser.TOKEN.ODO.BANG") - | Parser.TOKEN_YIELD -> getErrorString ("Parser.TOKEN.YIELD") - | Parser.TOKEN_YIELD_BANG -> getErrorString ("Parser.TOKEN.YIELD.BANG") - | Parser.TOKEN_OINTERFACE_MEMBER -> getErrorString ("Parser.TOKEN.OINTERFACE.MEMBER") - | Parser.TOKEN_ELIF -> getErrorString ("Parser.TOKEN.ELIF") - | Parser.TOKEN_RARROW -> getErrorString ("Parser.TOKEN.RARROW") - | Parser.TOKEN_SIG -> getErrorString ("Parser.TOKEN.SIG") - | Parser.TOKEN_STRUCT -> getErrorString ("Parser.TOKEN.STRUCT") - | Parser.TOKEN_UPCAST -> getErrorString ("Parser.TOKEN.UPCAST") - | Parser.TOKEN_DOWNCAST -> getErrorString ("Parser.TOKEN.DOWNCAST") - | Parser.TOKEN_NULL -> getErrorString ("Parser.TOKEN.NULL") - | Parser.TOKEN_RESERVED -> getErrorString ("Parser.TOKEN.RESERVED") + | Parser.TOKEN_ODO_BANG -> SR.GetString("Parser.TOKEN.ODO.BANG") + | Parser.TOKEN_YIELD -> SR.GetString("Parser.TOKEN.YIELD") + | Parser.TOKEN_YIELD_BANG -> SR.GetString("Parser.TOKEN.YIELD.BANG") + | Parser.TOKEN_OINTERFACE_MEMBER -> SR.GetString("Parser.TOKEN.OINTERFACE.MEMBER") + | Parser.TOKEN_ELIF -> SR.GetString("Parser.TOKEN.ELIF") + | Parser.TOKEN_RARROW -> SR.GetString("Parser.TOKEN.RARROW") + | Parser.TOKEN_SIG -> SR.GetString("Parser.TOKEN.SIG") + | Parser.TOKEN_STRUCT -> SR.GetString("Parser.TOKEN.STRUCT") + | Parser.TOKEN_UPCAST -> SR.GetString("Parser.TOKEN.UPCAST") + | Parser.TOKEN_DOWNCAST -> SR.GetString("Parser.TOKEN.DOWNCAST") + | Parser.TOKEN_NULL -> SR.GetString("Parser.TOKEN.NULL") + | Parser.TOKEN_RESERVED -> SR.GetString("Parser.TOKEN.RESERVED") | Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON - | Parser.TOKEN_MODULE_IS_HERE -> getErrorString ("Parser.TOKEN.MODULE") - | Parser.TOKEN_AND -> getErrorString ("Parser.TOKEN.AND") - | Parser.TOKEN_AS -> getErrorString ("Parser.TOKEN.AS") - | Parser.TOKEN_ASSERT -> getErrorString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_OASSERT -> getErrorString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_ASR -> getErrorString ("Parser.TOKEN.ASR") - | Parser.TOKEN_DOWNTO -> getErrorString ("Parser.TOKEN.DOWNTO") - | Parser.TOKEN_EXCEPTION -> getErrorString ("Parser.TOKEN.EXCEPTION") - | Parser.TOKEN_FALSE -> getErrorString ("Parser.TOKEN.FALSE") - | Parser.TOKEN_FOR -> getErrorString ("Parser.TOKEN.FOR") - | Parser.TOKEN_FUN -> getErrorString ("Parser.TOKEN.FUN") - | Parser.TOKEN_FUNCTION -> getErrorString ("Parser.TOKEN.FUNCTION") - | Parser.TOKEN_FINALLY -> getErrorString ("Parser.TOKEN.FINALLY") - | Parser.TOKEN_LAZY -> getErrorString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_OLAZY -> getErrorString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_MATCH -> getErrorString ("Parser.TOKEN.MATCH") - | Parser.TOKEN_MATCH_BANG -> getErrorString ("Parser.TOKEN.MATCH.BANG") - | Parser.TOKEN_MUTABLE -> getErrorString ("Parser.TOKEN.MUTABLE") - | Parser.TOKEN_NEW -> getErrorString ("Parser.TOKEN.NEW") - | Parser.TOKEN_OF -> getErrorString ("Parser.TOKEN.OF") - | Parser.TOKEN_OPEN -> getErrorString ("Parser.TOKEN.OPEN") - | Parser.TOKEN_OR -> getErrorString ("Parser.TOKEN.OR") - | Parser.TOKEN_VOID -> getErrorString ("Parser.TOKEN.VOID") - | Parser.TOKEN_EXTERN -> getErrorString ("Parser.TOKEN.EXTERN") - | Parser.TOKEN_INTERFACE -> getErrorString ("Parser.TOKEN.INTERFACE") - | Parser.TOKEN_REC -> getErrorString ("Parser.TOKEN.REC") - | Parser.TOKEN_TO -> getErrorString ("Parser.TOKEN.TO") - | Parser.TOKEN_TRUE -> getErrorString ("Parser.TOKEN.TRUE") - | Parser.TOKEN_TRY -> getErrorString ("Parser.TOKEN.TRY") + | Parser.TOKEN_MODULE_IS_HERE -> SR.GetString("Parser.TOKEN.MODULE") + | Parser.TOKEN_AND -> SR.GetString("Parser.TOKEN.AND") + | Parser.TOKEN_AS -> SR.GetString("Parser.TOKEN.AS") + | Parser.TOKEN_ASSERT -> SR.GetString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_OASSERT -> SR.GetString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_ASR -> SR.GetString("Parser.TOKEN.ASR") + | Parser.TOKEN_DOWNTO -> SR.GetString("Parser.TOKEN.DOWNTO") + | Parser.TOKEN_EXCEPTION -> SR.GetString("Parser.TOKEN.EXCEPTION") + | Parser.TOKEN_FALSE -> SR.GetString("Parser.TOKEN.FALSE") + | Parser.TOKEN_FOR -> SR.GetString("Parser.TOKEN.FOR") + | Parser.TOKEN_FUN -> SR.GetString("Parser.TOKEN.FUN") + | Parser.TOKEN_FUNCTION -> SR.GetString("Parser.TOKEN.FUNCTION") + | Parser.TOKEN_FINALLY -> SR.GetString("Parser.TOKEN.FINALLY") + | Parser.TOKEN_LAZY -> SR.GetString("Parser.TOKEN.LAZY") + | Parser.TOKEN_OLAZY -> SR.GetString("Parser.TOKEN.LAZY") + | Parser.TOKEN_MATCH -> SR.GetString("Parser.TOKEN.MATCH") + | Parser.TOKEN_MATCH_BANG -> SR.GetString("Parser.TOKEN.MATCH.BANG") + | Parser.TOKEN_MUTABLE -> SR.GetString("Parser.TOKEN.MUTABLE") + | Parser.TOKEN_NEW -> SR.GetString("Parser.TOKEN.NEW") + | Parser.TOKEN_OF -> SR.GetString("Parser.TOKEN.OF") + | Parser.TOKEN_OPEN -> SR.GetString("Parser.TOKEN.OPEN") + | Parser.TOKEN_OR -> SR.GetString("Parser.TOKEN.OR") + | Parser.TOKEN_VOID -> SR.GetString("Parser.TOKEN.VOID") + | Parser.TOKEN_EXTERN -> SR.GetString("Parser.TOKEN.EXTERN") + | Parser.TOKEN_INTERFACE -> SR.GetString("Parser.TOKEN.INTERFACE") + | Parser.TOKEN_REC -> SR.GetString("Parser.TOKEN.REC") + | Parser.TOKEN_TO -> SR.GetString("Parser.TOKEN.TO") + | Parser.TOKEN_TRUE -> SR.GetString("Parser.TOKEN.TRUE") + | Parser.TOKEN_TRY -> SR.GetString("Parser.TOKEN.TRY") | Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON - | Parser.TOKEN_TYPE_IS_HERE -> getErrorString ("Parser.TOKEN.TYPE") - | Parser.TOKEN_VAL -> getErrorString ("Parser.TOKEN.VAL") - | Parser.TOKEN_INLINE -> getErrorString ("Parser.TOKEN.INLINE") - | Parser.TOKEN_WHEN -> getErrorString ("Parser.TOKEN.WHEN") - | Parser.TOKEN_WHILE -> getErrorString ("Parser.TOKEN.WHILE") - | Parser.TOKEN_WITH -> getErrorString ("Parser.TOKEN.WITH") - | Parser.TOKEN_IF -> getErrorString ("Parser.TOKEN.IF") - | Parser.TOKEN_DO -> getErrorString ("Parser.TOKEN.DO") - | Parser.TOKEN_GLOBAL -> getErrorString ("Parser.TOKEN.GLOBAL") - | Parser.TOKEN_DONE -> getErrorString ("Parser.TOKEN.DONE") + | Parser.TOKEN_TYPE_IS_HERE -> SR.GetString("Parser.TOKEN.TYPE") + | Parser.TOKEN_VAL -> SR.GetString("Parser.TOKEN.VAL") + | Parser.TOKEN_INLINE -> SR.GetString("Parser.TOKEN.INLINE") + | Parser.TOKEN_WHEN -> SR.GetString("Parser.TOKEN.WHEN") + | Parser.TOKEN_WHILE -> SR.GetString("Parser.TOKEN.WHILE") + | Parser.TOKEN_WITH -> SR.GetString("Parser.TOKEN.WITH") + | Parser.TOKEN_IF -> SR.GetString("Parser.TOKEN.IF") + | Parser.TOKEN_DO -> SR.GetString("Parser.TOKEN.DO") + | Parser.TOKEN_GLOBAL -> SR.GetString("Parser.TOKEN.GLOBAL") + | Parser.TOKEN_DONE -> SR.GetString("Parser.TOKEN.DONE") | Parser.TOKEN_IN - | Parser.TOKEN_JOIN_IN -> getErrorString ("Parser.TOKEN.IN") - | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") - | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") - | Parser.TOKEN_BEGIN -> getErrorString ("Parser.TOKEN.BEGIN") - | Parser.TOKEN_END -> getErrorString ("Parser.TOKEN.END") + | Parser.TOKEN_JOIN_IN -> SR.GetString("Parser.TOKEN.IN") + | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") + | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") + | Parser.TOKEN_BEGIN -> SR.GetString("Parser.TOKEN.BEGIN") + | Parser.TOKEN_END -> SR.GetString("Parser.TOKEN.END") | Parser.TOKEN_HASH_LIGHT | Parser.TOKEN_HASH_LINE | Parser.TOKEN_HASH_IF | Parser.TOKEN_HASH_ELSE - | Parser.TOKEN_HASH_ENDIF -> getErrorString ("Parser.TOKEN.HASH.ENDIF") - | Parser.TOKEN_INACTIVECODE -> getErrorString ("Parser.TOKEN.INACTIVECODE") - | Parser.TOKEN_LEX_FAILURE -> getErrorString ("Parser.TOKEN.LEX.FAILURE") - | Parser.TOKEN_WHITESPACE -> getErrorString ("Parser.TOKEN.WHITESPACE") - | Parser.TOKEN_COMMENT -> getErrorString ("Parser.TOKEN.COMMENT") - | Parser.TOKEN_LINE_COMMENT -> getErrorString ("Parser.TOKEN.LINE.COMMENT") - | Parser.TOKEN_STRING_TEXT -> getErrorString ("Parser.TOKEN.STRING.TEXT") - | Parser.TOKEN_BYTEARRAY -> getErrorString ("Parser.TOKEN.BYTEARRAY") - | Parser.TOKEN_STRING -> getErrorString ("Parser.TOKEN.STRING") - | Parser.TOKEN_KEYWORD_STRING -> getErrorString ("Parser.TOKEN.KEYWORD_STRING") - | Parser.TOKEN_EOF -> getErrorString ("Parser.TOKEN.EOF") - | Parser.TOKEN_CONST -> getErrorString ("Parser.TOKEN.CONST") - | Parser.TOKEN_FIXED -> getErrorString ("Parser.TOKEN.FIXED") - | Parser.TOKEN_INTERP_STRING_BEGIN_END -> getErrorString ("Parser.TOKEN.INTERP.STRING.BEGIN.END") - | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> getErrorString ("Parser.TOKEN.INTERP.STRING.BEGIN.PART") - | Parser.TOKEN_INTERP_STRING_PART -> getErrorString ("Parser.TOKEN.INTERP.STRING.PART") - | Parser.TOKEN_INTERP_STRING_END -> getErrorString ("Parser.TOKEN.INTERP.STRING.END") + | Parser.TOKEN_HASH_ENDIF -> SR.GetString("Parser.TOKEN.HASH.ENDIF") + | Parser.TOKEN_INACTIVECODE -> SR.GetString("Parser.TOKEN.INACTIVECODE") + | Parser.TOKEN_LEX_FAILURE -> SR.GetString("Parser.TOKEN.LEX.FAILURE") + | Parser.TOKEN_WHITESPACE -> SR.GetString("Parser.TOKEN.WHITESPACE") + | Parser.TOKEN_COMMENT -> SR.GetString("Parser.TOKEN.COMMENT") + | Parser.TOKEN_LINE_COMMENT -> SR.GetString("Parser.TOKEN.LINE.COMMENT") + | Parser.TOKEN_STRING_TEXT -> SR.GetString("Parser.TOKEN.STRING.TEXT") + | Parser.TOKEN_BYTEARRAY -> SR.GetString("Parser.TOKEN.BYTEARRAY") + | Parser.TOKEN_STRING -> SR.GetString("Parser.TOKEN.STRING") + | Parser.TOKEN_KEYWORD_STRING -> SR.GetString("Parser.TOKEN.KEYWORD_STRING") + | Parser.TOKEN_EOF -> SR.GetString("Parser.TOKEN.EOF") + | Parser.TOKEN_CONST -> SR.GetString("Parser.TOKEN.CONST") + | Parser.TOKEN_FIXED -> SR.GetString("Parser.TOKEN.FIXED") + | Parser.TOKEN_INTERP_STRING_BEGIN_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.END") + | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.PART") + | Parser.TOKEN_INTERP_STRING_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.PART") + | Parser.TOKEN_INTERP_STRING_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.END") | unknown -> Debug.Assert(false, "unknown token tag") let result = sprintf "%+A" unknown @@ -1650,12 +1651,10 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(ConvertValLogicalNameToDisplayNameCore s) - suggestNames suggestionF idText + OutputNameSuggestions os suggestNames suggestionF idText | InternalError (s, _) - | InvalidArgument s - | Failure s as exn -> ignore exn // use the argument, even in non DEBUG let f1 = SR.GetString("Failure1") @@ -1670,7 +1669,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) #endif - | WrappedError (exn, _) -> OutputExceptionR os exn + | WrappedError (e, _) -> e.Output(os, suggestNames) | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) -> os.AppendString(MatchIncomplete1E().Format) @@ -1825,17 +1824,17 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu os.AppendString(FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar) |> snd) | HashLoadedSourceHasIssues (infos, warnings, errors, _) -> - let Emit (l: exn list) = OutputExceptionR os (List.head l) - if isNil warnings && isNil errors then - os.AppendString(HashLoadedSourceHasIssues0E().Format) - Emit infos - elif isNil errors then - os.AppendString(HashLoadedSourceHasIssues1E().Format) - Emit warnings - else + match warnings, errors with + | _, e :: _ -> os.AppendString(HashLoadedSourceHasIssues2E().Format) - Emit errors + e.Output(os, suggestNames) + | e :: _, _ -> + os.AppendString(HashLoadedSourceHasIssues1E().Format) + e.Output(os, suggestNames) + | [], [] -> + os.AppendString(HashLoadedSourceHasIssues0E().Format) + infos.Head.Output(os, suggestNames) | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format) @@ -1851,7 +1850,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code) // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as exn -> OutputExceptionR os exn.InnerException + | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames) | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message @@ -1874,21 +1873,37 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (exn.ToString())) #endif - OutputExceptionR os diagnostic.Exception +/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText +type PhasedDiagnostic with -// remove any newlines and tabs -let OutputPhasedDiagnostic (os: StringBuilder) (diagnostic: PhasedDiagnostic) (flattenErrors: bool) (suggestNames: bool) = - let buf = StringBuilder() + // remove any newlines and tabs + member x.OutputCore(os: StringBuilder, flattenErrors: bool, suggestNames: bool) = + let buf = StringBuilder() - OutputPhasedErrorR buf diagnostic suggestNames + x.Exception.Output(buf, suggestNames) - let text = - if flattenErrors then - NormalizeErrorString(buf.ToString()) - else - buf.ToString() + let text = + if flattenErrors then + NormalizeErrorString(buf.ToString()) + else + buf.ToString() + + os.AppendString text + + member x.FormatCore(flattenErrors: bool, suggestNames: bool) = + let os = StringBuilder() + x.OutputCore(os, flattenErrors, suggestNames) + os.ToString() - os.AppendString text + member x.EagerlyFormatCore(suggestNames: bool) = + match x.Range with + | Some m -> + let buf = StringBuilder() + x.Exception.Output(buf, suggestNames) + let message = buf.ToString() + let exn = DiagnosticWithText(x.Number, message, m) + { Exception = exn; Phase = x.Phase } + | None -> x let SanitizeFileName fileName implicitIncludeDir = // The assert below is almost ok, but it fires in two cases: @@ -1939,87 +1954,79 @@ type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo -/// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectFormattedDiagnostics - ( - implicitIncludeDir, - showFullPaths, - flattenErrors, - diagnosticStyle, - severity: FSharpDiagnosticSeverity, - diagnostic: PhasedDiagnostic, - suggestNames: bool - ) = - let outputWhere (showFullPaths, diagnosticStyle) m : FormattedDiagnosticLocation = - if equals m rangeStartup || equals m rangeCmdArgs then - { - Range = m - TextRepresentation = "" - IsEmpty = true - File = "" - } - else - let file = m.FileName +let FormatDiagnosticLocation (tcConfig: TcConfig) m : FormattedDiagnosticLocation = + if equals m rangeStartup || equals m rangeCmdArgs then + { + Range = m + TextRepresentation = "" + IsEmpty = true + File = "" + } + else + let file = m.FileName - let file = - if showFullPaths then - FileSystem.GetFullFilePathInDirectoryShim implicitIncludeDir file - else - SanitizeFileName file implicitIncludeDir - - let text, m, file = - match diagnosticStyle with - | DiagnosticStyle.Emacs -> - let file = file.Replace("\\", "/") - (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file - - // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output - | DiagnosticStyle.Default -> - let file = file.Replace('/', Path.DirectorySeparatorChar) - let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End - (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file - - // We may also want to change Test to be 1-based - | DiagnosticStyle.Test -> + let file = + if tcConfig.showFullPaths then + FileSystem.GetFullFilePathInDirectoryShim tcConfig.implicitIncludeDir file + else + SanitizeFileName file tcConfig.implicitIncludeDir + + let text, m, file = + match tcConfig.diagnosticStyle with + | DiagnosticStyle.Emacs -> + let file = file.Replace("\\", "/") + (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file + + // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output + | DiagnosticStyle.Default -> + let file = file.Replace('/', Path.DirectorySeparatorChar) + let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End + (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file + + // We may also want to change Test to be 1-based + | DiagnosticStyle.Test -> + let file = file.Replace("/", "\\") + + let m = + mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + + sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file + + | DiagnosticStyle.Gcc -> + let file = file.Replace('/', Path.DirectorySeparatorChar) + + let m = + mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + + sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file + + // Here, we want the complete range information so Project Systems can generate proper squiggles + | DiagnosticStyle.VisualStudio -> + // Show prefix only for real files. Otherwise, we just want a truncated error like: + // parse error FS0031: blah blah + if + not (equals m range0) + && not (equals m rangeStartup) + && not (equals m rangeCmdArgs) + then let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) - sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - - | DiagnosticStyle.Gcc -> - let file = file.Replace('/', Path.DirectorySeparatorChar) - - let m = - mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) - - sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file - - // Here, we want the complete range information so Project Systems can generate proper squiggles - | DiagnosticStyle.VisualStudio -> - // Show prefix only for real files. Otherwise, we just want a truncated error like: - // parse error FS0031: blah blah - if - not (equals m range0) - && not (equals m rangeStartup) - && not (equals m rangeCmdArgs) - then - let file = file.Replace("/", "\\") - - let m = - mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file + else + "", m, file - sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - else - "", m, file + { + Range = m + TextRepresentation = text + IsEmpty = false + File = file + } - { - Range = m - TextRepresentation = text - IsEmpty = false - File = file - } +/// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors +let CollectFormattedDiagnostics (tcConfig: TcConfig, severity: FSharpDiagnosticSeverity, diagnostic: PhasedDiagnostic, suggestNames: bool) = match diagnostic.Exception with | ReportedError _ -> @@ -2031,42 +2038,36 @@ let CollectFormattedDiagnostics | _ -> let errors = ResizeArray() - let report diagnostic = - let OutputWhere diagnostic = - match GetRangeOfDiagnostic diagnostic with - | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) + let report (diagnostic: PhasedDiagnostic) = + let where = + match diagnostic.Range with + | Some m -> FormatDiagnosticLocation tcConfig m |> Some | None -> None - let OutputCanonicalInformation (subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = - let message = - match severity with - | FSharpDiagnosticSeverity.Error -> "error" - | FSharpDiagnosticSeverity.Warning -> "warning" - | FSharpDiagnosticSeverity.Info - | FSharpDiagnosticSeverity.Hidden -> "info" - - let text = - match diagnosticStyle with - // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber - | _ -> sprintf "%s FS%04d: " message errorNumber + let subcategory = diagnostic.Subcategory() + let errorNumber = diagnostic.Number + let message = + match severity with + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Info + | FSharpDiagnosticSeverity.Hidden -> "info" + + let text = + match tcConfig.diagnosticStyle with + // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. + | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | _ -> sprintf "%s FS%04d: " message errorNumber + + let canonical: FormattedDiagnosticCanonicalInformation = { ErrorNumber = errorNumber Subcategory = subcategory TextRepresentation = text } - let mainError, relatedErrors = SplitRelatedDiagnostics diagnostic - let where = OutputWhere mainError - - let canonical = - OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber mainError) - - let message = - let os = StringBuilder() - OutputPhasedDiagnostic os mainError flattenErrors suggestNames - os.ToString() + let message = diagnostic.FormatCore(tcConfig.flatErrors, suggestNames) let entry: FormattedDiagnosticDetailedInfo = { @@ -2077,127 +2078,56 @@ let CollectFormattedDiagnostics errors.Add(FormattedDiagnostic.Long(severity, entry)) - let OutputRelatedError (diagnostic: PhasedDiagnostic) = - match diagnosticStyle with - // Give a canonical string when --vserror. - | DiagnosticStyle.VisualStudio -> - let relWhere = OutputWhere mainError // mainError? - - let relCanonical = - OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code - - let relMessage = - let os = StringBuilder() - OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames - os.ToString() - - let entry: FormattedDiagnosticDetailedInfo = - { - Location = relWhere - Canonical = relCanonical - Message = relMessage - } - - errors.Add(FormattedDiagnostic.Long(severity, entry)) - - | _ -> - let os = StringBuilder() - OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames - errors.Add(FormattedDiagnostic.Short(severity, os.ToString())) - - relatedErrors |> List.iter OutputRelatedError - - match diagnostic with + match diagnostic.Exception with #if !NO_TYPEPROVIDERS - | { - Exception = :? TypeProviderError as tpe - } -> - tpe.Iter(fun exn -> - let newErr = { diagnostic with Exception = exn } - report newErr) + | :? TypeProviderError as tpe -> tpe.Iter(fun exn -> report { diagnostic with Exception = exn }) #endif - | x -> report x + | _ -> report diagnostic errors.ToArray() -/// used by fsc.exe and fsi.exe, but not by VS -/// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diagnostic: PhasedDiagnostic) = +type PhasedDiagnostic with - // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = - CollectFormattedDiagnostics(implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diagnostic, true) + /// used by fsc.exe and fsi.exe, but not by VS + /// prints error and related errors to the specified StringBuilder + member diagnostic.Output(buf, tcConfig: TcConfig, severity) = - for e in errors do - Printf.bprintf os "\n" + // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. + let diagnostics = CollectFormattedDiagnostics(tcConfig, severity, diagnostic, true) - match e with - | FormattedDiagnostic.Short (_, txt) -> os.AppendString txt |> ignore - | FormattedDiagnostic.Long (_, details) -> - match details.Location with - | Some l when not l.IsEmpty -> os.AppendString l.TextRepresentation - | _ -> () + for e in diagnostics do + Printf.bprintf buf "\n" + + match e with + | FormattedDiagnostic.Short (_, txt) -> buf.AppendString txt |> ignore + | FormattedDiagnostic.Long (_, details) -> + match details.Location with + | Some l when not l.IsEmpty -> buf.AppendString l.TextRepresentation + | _ -> () - os.AppendString details.Canonical.TextRepresentation - os.AppendString details.Message - -let OutputDiagnosticContext prefix fileLineFunction os diagnostic = - match GetRangeOfDiagnostic diagnostic with - | None -> () - | Some m -> - let fileName = m.FileName - let lineA = m.StartLine - let lineB = m.EndLine - let line = fileLineFunction fileName lineA - - if line <> "" then - let iA = m.StartColumn - let iB = m.EndColumn - let iLen = if lineA = lineB then max (iB - iA) 1 else 1 - Printf.bprintf os "%s%s\n" prefix line - Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') - -let ReportDiagnosticAsInfo options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> false - | FSharpDiagnosticSeverity.Warning -> false - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnOff) - | FSharpDiagnosticSeverity.Hidden -> false - -let ReportDiagnosticAsWarning options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> false - | FSharpDiagnosticSeverity.Warning -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnOff) - // Informational become warning if explicitly on and not explicitly off - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - List.contains n options.WarnOn && not (List.contains n options.WarnOff) - | FSharpDiagnosticSeverity.Hidden -> false - -let ReportDiagnosticAsError options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> true - // Warnings become errors in some situations - | FSharpDiagnosticSeverity.Warning -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnAsWarn) - && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff)) - || List.contains n options.WarnAsError) - // Informational become errors if explicitly WarnAsError - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - List.contains n options.WarnAsError - | FSharpDiagnosticSeverity.Hidden -> false + buf.AppendString details.Canonical.TextRepresentation + buf.AppendString details.Message + + member diagnostic.OutputContext(buf, prefix, fileLineFunction) = + match diagnostic.Range with + | None -> () + | Some m -> + let fileName = m.FileName + let lineA = m.StartLine + let lineB = m.EndLine + let line = fileLineFunction fileName lineA + + if line <> "" then + let iA = m.StartColumn + let iB = m.EndColumn + let iLen = if lineA = lineB then max (iB - iA) 1 else 1 + Printf.bprintf buf "%s%s\n" prefix line + Printf.bprintf buf "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') + + member diagnostic.WriteWithContext(os, prefix, fileLineFunction, tcConfig, severity) = + writeViaBuffer os (fun buf -> + diagnostic.OutputContext(buf, prefix, fileLineFunction) + diagnostic.Output(buf, tcConfig, severity)) //---------------------------------------------------------------------------- // Scoped #nowarn pragmas @@ -2219,14 +2149,14 @@ type DiagnosticsLoggerFilteringByScopedPragmas ) = inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas") - override _.DiagnosticSink(diagnostic, severity) = + override _.DiagnosticSink(diagnostic: PhasedDiagnostic, severity) = if severity = FSharpDiagnosticSeverity.Error then diagnosticsLogger.DiagnosticSink(diagnostic, severity) else let report = - let warningNum = GetDiagnosticNumber diagnostic + let warningNum = diagnostic.Number - match GetRangeOfDiagnostic diagnostic with + match diagnostic.Range with | Some m -> scopedPragmas |> List.exists (fun pragma -> @@ -2239,11 +2169,11 @@ type DiagnosticsLoggerFilteringByScopedPragmas | None -> true if report then - if ReportDiagnosticAsError diagnosticOptions (diagnostic, severity) then + if diagnostic.ReportAsError(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Error) - elif ReportDiagnosticAsWarning diagnosticOptions (diagnostic, severity) then + elif diagnostic.ReportAsWarning(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo diagnosticOptions (diagnostic, severity) then + elif diagnostic.ReportAsInfo(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, severity) override _.ErrorCount = diagnosticsLogger.ErrorCount diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 8f76210f91f..8e0890d4418 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -4,14 +4,14 @@ module internal FSharp.Compiler.CompilerDiagnostics open System.Text +open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text #if DEBUG -module internal CompilerService = - val showAssertForUnexpectedException: bool ref +val showAssertForUnexpectedException: bool ref /// For extra diagnostics val mutable showParserStackOnParseError: bool @@ -47,48 +47,51 @@ exception DeprecatedCommandLineOptionNoDescription of string * range /// This exception is an old-style way of reporting a diagnostic exception InternalCommandLineOption of string * range -/// Get the location associated with an error -val GetRangeOfDiagnostic: diagnostic: PhasedDiagnostic -> range option +type PhasedDiagnostic with -/// Get the number associated with an error -val GetDiagnosticNumber: diagnostic: PhasedDiagnostic -> int + /// Get the location associated with a diagnostic + member Range: range option -/// Split errors into a "main" error and a set of associated errors -val SplitRelatedDiagnostics: diagnostic: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagnostic list + /// Get the number associated with a diagnostic + member Number: int -/// Output an error to a buffer -val OutputPhasedDiagnostic: - os: StringBuilder -> diagnostic: PhasedDiagnostic -> flattenErrors: bool -> suggestNames: bool -> unit + /// Eagerly format a PhasedDiagnostic return as a new PhasedDiagnostic requiring no formatting of types. + member EagerlyFormatCore: suggestNames: bool -> PhasedDiagnostic -/// Output an error or warning to a buffer -val OutputDiagnostic: - implicitIncludeDir: string * - showFullPaths: bool * - flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * - severity: FSharpDiagnosticSeverity -> - StringBuilder -> - PhasedDiagnostic -> - unit + /// Format the core of the diagnostic as a string. Doesn't include the range information. + member FormatCore: flattenErrors: bool * suggestNames: bool -> string -/// Output extra context information for an error or warning to a buffer -val OutputDiagnosticContext: - prefix: string -> fileLineFunction: (string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit + /// Indicates if a diagnostic should be reported as an informational + member ReportAsInfo: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool -/// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetDiagnosticsLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger + /// Indicates if a diagnostic should be reported as a warning + member ReportAsWarning: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool -val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string + /// Indicates if a diagnostic should be reported as an error + member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + /// Output all of a diagnostic to a buffer, including range + member Output: buf: StringBuilder * tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + /// Write extra context information for a diagnostic + member WriteWithContext: + os: System.IO.TextWriter * + prefix: string * + fileLineFunction: (string -> int -> string) * + tcConfig: TcConfig * + severity: FSharpDiagnosticSeverity -> + unit -/// Indicates if we should report a warning as an error -val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool +/// Get a diagnostics logger that filters the reporting of warnings based on scoped pragma information +val GetDiagnosticsLoggerFilteringByScopedPragmas: + checkFile: bool * + scopedPragmas: ScopedPragma list * + diagnosticOptions: FSharpDiagnosticOptions * + diagnosticsLogger: DiagnosticsLogger -> + DiagnosticsLogger + +/// Remove 'implicitIncludeDir' from a file name before output +val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string /// Used internally and in LegacyHostedCompilerForTesting [] @@ -120,11 +123,5 @@ type FormattedDiagnostic = /// Used internally and in LegacyHostedCompilerForTesting val CollectFormattedDiagnostics: - implicitIncludeDir: string * - showFullPaths: bool * - flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * - severity: FSharpDiagnosticSeverity * - PhasedDiagnostic * - suggestNames: bool -> + tcConfig: TcConfig * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> FormattedDiagnostic[] diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 0958224400d..22162611f0c 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -342,8 +342,8 @@ type ImportedAssembly = } type AvailableImportedAssembly = - | ResolvedImportedAssembly of ImportedAssembly - | UnresolvedImportedAssembly of string + | ResolvedImportedAssembly of ImportedAssembly * range + | UnresolvedImportedAssembly of string * range type CcuLoadFailureAction = | RaiseError @@ -382,7 +382,7 @@ type TcConfig with member tcConfig.TryResolveLibWithDirectories(r: AssemblyReference) = let m, nm = r.Range, r.Text - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter // See if the language service has already produced the contents of the assembly for us, virtually match r.ProjectReference with @@ -436,7 +436,7 @@ type TcConfig with member tcConfig.ResolveLibWithDirectories(ccuLoadFailureAction, r: AssemblyReference) = let m, nm = r.Range, r.Text - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let rs = if IsExe nm || IsDLL nm || IsNetModule nm then @@ -504,7 +504,7 @@ type TcConfig with mode: ResolveAssemblyReferenceMode ) : AssemblyResolution list * UnresolvedAssemblyReference list = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter if tcConfig.useSimpleResolution then failwith "MSBuild resolution is not supported." @@ -801,7 +801,7 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, TcAssemblyResolutions.ResolveAssemblyReferences(tcConfig, references, knownUnresolved) static member GetAssemblyResolutionInformation(tcConfig: TcConfig) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig let resolutions = @@ -1024,33 +1024,77 @@ type TcImportsSafeDisposal dispose () #if !NO_TYPEPROVIDERS -// These are hacks in order to allow TcImports to be held as a weak reference inside a type provider. -// The reason is due to older type providers compiled using an older TypeProviderSDK, that SDK used reflection on fields and properties to determine the contract. -// The reflection code has now since been removed, see here: https://github.com/fsprojects/FSharp.TypeProviders.SDK/pull/305. But we still need to work on older type providers. -// One day we can remove these hacks when we deemed most if not all type providers were re-compiled using the newer TypeProviderSDK. -// Yuck. -type TcImportsDllInfoHack = { FileName: string } -and TcImportsWeakHack(tciLock: TcImportsLock, tcImports: WeakReference) = - let mutable dllInfos: TcImportsDllInfoHack list = [] +// TcImports is held as a weak reference inside a TypeProviderConfig. +// +// Due to various historical bugs with the ReferencedAssemblies property of TypeProviderConfig, +// type providers compiled using the TypeProvider SDK have picked up the unfortunate habit of using +// private reflection on the TypeProviderConfig to correctly determine the ReferencedAssemblies. +// These types thus also act as a stable facade supporting exactly the private reflection that is +// used by type providers built with the TypeProvider SDK. +// +// The use of private reflection is highly unfortunate but has historically been the only way to +// unblock several important type providers such as FSharp.Data when the weaknesses in reported +// ReferencedAssemblies were determined. +// +// The use of private reflection was removed from the TypeProvider SDK, see +// https://github.com/fsprojects/FSharp.TypeProviders.SDK/pull/305. But we still need to work on older type providers. +// +// however it was then reinstated +// +// https://github.com/fsprojects/FSharp.TypeProviders.SDK/pull/388 +// +// All known issues TypeProviderConfig::ReferencedAssemblies are now fixed, meaning one day +// we can remove the use of private reflection from the TPSDK (that is, once the F# tooling fixes +// can be assumed to be shipped in all F# tooling where type providers have to load). After that, +// once all type providers are updated, we will no longer need to have this fixed facade. + +/// This acts as a stable type supporting the +type TcImportsDllInfoFacade = { FileName: string } + +type TcImportsWeakFacade(tciLock: TcImportsLock, tcImportsWeak: WeakReference) = + + let mutable dllInfos: TcImportsDllInfoFacade list = [] + + // The name of these fields must not change, see above + do assert (nameof (dllInfos) = "dllInfos") member _.SetDllInfos(value: ImportedBinary list) = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, dllInfos) - dllInfos <- value |> List.map (fun x -> { FileName = x.FileName })) - member _.Base: TcImportsWeakHack option = - match tcImports.TryGetTarget() with - | true, strong -> - match strong.Base with + let infos = + [ + for x in value do + let info = { FileName = x.FileName } + // The name of this field must not change, see above + assert (nameof (info.FileName) = "FileName") + info + ] + + dllInfos <- infos) + + member this.Base: TcImportsWeakFacade option = + // The name of this property msut not change, see above + assert (nameof (this.Base) = "Base") + + match tcImportsWeak.TryGetTarget() with + | true, tcImports -> + match tcImports.Base with | Some (baseTcImports: TcImports) -> Some baseTcImports.Weak | _ -> None | _ -> None member _.SystemRuntimeContainsType typeName = - match tcImports.TryGetTarget() with - | true, strong -> strong.SystemRuntimeContainsType typeName + match tcImportsWeak.TryGetTarget() with + | true, tcImports -> tcImports.SystemRuntimeContainsType typeName | _ -> false + + member _.AllAssemblyResolutions() = + match tcImportsWeak.TryGetTarget() with + | true, tcImports -> tcImports.AllAssemblyResolutions() + | _ -> [] + #endif /// Represents a table of imported assemblies with their resolutions. /// Is a disposable object, but it is recommended not to explicitly call Dispose unless you absolutely know nothing will be using its contents after the disposal. @@ -1082,7 +1126,7 @@ and [] TcImports let mutable generatedTypeRoots = Dictionary() - let tcImportsWeak = TcImportsWeakHack(tciLock, WeakReference<_> this) + let tcImportsWeak = TcImportsWeakFacade(tciLock, WeakReference<_> this) #endif let disposal = @@ -1140,29 +1184,29 @@ and [] TcImports | None -> false | None -> false - member internal tcImports.Base = + member internal _.Base = CheckDisposed() importsBase - member tcImports.CcuTable = + member _.CcuTable = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, ccuTable) CheckDisposed() ccuTable) - member tcImports.DllTable = + member _.DllTable = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, dllTable) CheckDisposed() dllTable) #if !NO_TYPEPROVIDERS - member tcImports.Weak = + member _.Weak = CheckDisposed() tcImportsWeak #endif - member tcImports.RegisterCcu ccuInfo = + member _.RegisterCcu ccuInfo = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, ccuInfos) @@ -1171,7 +1215,7 @@ and [] TcImports // Assembly Ref Resolution: remove this use of ccu.AssemblyName ccuTable <- NameMap.add ccuInfo.FSharpViewOfMetadata.AssemblyName ccuInfo ccuTable) - member tcImports.RegisterDll dllInfo = + member _.RegisterDll dllInfo = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, dllInfos) @@ -1182,7 +1226,7 @@ and [] TcImports #endif dllTable <- NameMap.add (getNameOfScopeRef dllInfo.ILScopeRef) dllInfo dllTable) - member tcImports.GetDllInfos() : ImportedBinary list = + member _.GetDllInfos() : ImportedBinary list = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, dllInfos) @@ -1191,7 +1235,7 @@ and [] TcImports | Some importsBase -> importsBase.GetDllInfos() @ dllInfos | None -> dllInfos) - member tcImports.AllAssemblyResolutions() = + member _.AllAssemblyResolutions() = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, resolutions) @@ -1223,7 +1267,7 @@ and [] TcImports | Some res -> res | None -> error (Error(FSComp.SR.buildCouldNotResolveAssembly assemblyName, m)) - member tcImports.GetImportedAssemblies() = + member _.GetImportedAssemblies() = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, ccuInfos) @@ -1232,7 +1276,7 @@ and [] TcImports | Some importsBase -> List.append (importsBase.GetImportedAssemblies()) ccuInfos | None -> ccuInfos) - member tcImports.GetCcusExcludingBase() = + member _.GetCcusExcludingBase() = tciLock.AcquireLock(fun tcitok -> CheckDisposed() RequireTcImportsLock(tcitok, ccuInfos) @@ -1255,26 +1299,26 @@ and [] TcImports | None -> None match look tcImports with - | Some res -> ResolvedImportedAssembly res + | Some res -> ResolvedImportedAssembly(res, m) | None -> tcImports.ImplicitLoadIfAllowed(ctok, m, assemblyName, lookupOnly) match look tcImports with - | Some res -> ResolvedImportedAssembly res - | None -> UnresolvedImportedAssembly assemblyName + | Some res -> ResolvedImportedAssembly(res, m) + | None -> UnresolvedImportedAssembly(assemblyName, m) member tcImports.FindCcu(ctok, m, assemblyName, lookupOnly) = CheckDisposed() match tcImports.FindCcuInfo(ctok, m, assemblyName, lookupOnly) with - | ResolvedImportedAssembly importedAssembly -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) - | UnresolvedImportedAssembly assemblyName -> UnresolvedCcu assemblyName + | ResolvedImportedAssembly (importedAssembly, _) -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) + | UnresolvedImportedAssembly (assemblyName, _) -> UnresolvedCcu assemblyName member tcImports.FindCcuFromAssemblyRef(ctok, m, assemblyRef: ILAssemblyRef) = CheckDisposed() match tcImports.FindCcuInfo(ctok, m, assemblyRef.Name, lookupOnly = false) with - | ResolvedImportedAssembly importedAssembly -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) + | ResolvedImportedAssembly (importedAssembly, _) -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) | UnresolvedImportedAssembly _ -> UnresolvedCcu(assemblyRef.QualifiedName) member tcImports.TryFindXmlDocumentationInfo(assemblyName: string) = @@ -1393,7 +1437,7 @@ and [] TcImports // Yes, it is generative true, dllinfo.ProviderGeneratedStaticLinkMap - member tcImports.RecordGeneratedTypeRoot root = + member _.RecordGeneratedTypeRoot root = tciLock.AcquireLock(fun tcitok -> // checking if given ProviderGeneratedType was already recorded before (probably for another set of static parameters) let (ProviderGeneratedType (_, ilTyRef, _)) = root @@ -1407,7 +1451,7 @@ and [] TcImports generatedTypeRoots[ilTyRef] <- (index, root)) - member tcImports.ProviderGeneratedTypeRoots = + member _.ProviderGeneratedTypeRoots = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, generatedTypeRoots) generatedTypeRoots.Values |> Seq.sortBy fst |> Seq.map snd |> Seq.toList) @@ -1549,7 +1593,7 @@ and [] TcImports // types such as those in method signatures are currently converted on-demand. However ImportILAssembly does have to // convert the types that are constraints in generic parameters, which was the original motivation for making sure that // ImportILAssembly had a tcGlobals available when it really needs it. - member tcImports.GetTcGlobals() : TcGlobals = + member _.GetTcGlobals() : TcGlobals = CheckDisposed() match tcGlobals with @@ -1695,30 +1739,40 @@ and [] TcImports let name = AssemblyName.GetAssemblyName(resolution.resolvedPath) name.Version - let typeProviderEnvironment = - { - ResolutionFolder = tcConfig.implicitIncludeDir - OutputFile = tcConfig.outputFile - ShowResolutionMessages = tcConfig.showExtensionTypeMessages - ReferencedAssemblies = Array.distinct [| for r in tcImportsStrong.AllAssemblyResolutions() -> r.resolvedPath |] - TemporaryFolder = FileSystem.GetTempPathShim() - } - - // The type provider should not hold strong references to disposed - // TcImport objects. So the callbacks provided in the type provider config - // dispatch via a thunk which gets set to a non-resource-capturing - // failing function when the object is disposed. + // Note, this only captures systemRuntimeContainsTypeRef (which captures tcImportsWeak, using name tcImports) let systemRuntimeContainsType = - // NOTE: do not touch this, edit: but we did, we had no choice - TPs cannot hold a strong reference on TcImports "ever". let tcImports = tcImportsWeak + // The name of this captured value must not change, see comments on TcImportsWeakFacade above + assert (nameof (tcImports) = "tcImports") + let mutable systemRuntimeContainsTypeRef = - fun typeName -> tcImports.SystemRuntimeContainsType typeName + (fun typeName -> tcImports.SystemRuntimeContainsType typeName) + // When the tcImports is disposed the systemRuntimeContainsTypeRef thunk is replaced + // with one raising an exception. tcImportsStrong.AttachDisposeTypeProviderAction(fun () -> systemRuntimeContainsTypeRef <- fun _ -> raise (ObjectDisposedException("The type provider has been disposed"))) - fun arg -> systemRuntimeContainsTypeRef arg + (fun arg -> systemRuntimeContainsTypeRef arg) + + // Note, this only captures tcImportsWeak + let mutable getReferencedAssemblies = + (fun () -> [| for r in tcImportsWeak.AllAssemblyResolutions() -> r.resolvedPath |]) + + // When the tcImports is disposed the getReferencedAssemblies thunk is replaced + // with one raising an exception. + tcImportsStrong.AttachDisposeTypeProviderAction(fun () -> + getReferencedAssemblies <- fun _ -> raise (ObjectDisposedException("The type provider has been disposed"))) + + let typeProviderEnvironment = + { + ResolutionFolder = tcConfig.implicitIncludeDir + OutputFile = tcConfig.outputFile + ShowResolutionMessages = tcConfig.showExtensionTypeMessages + GetReferencedAssemblies = (fun () -> [| for r in tcImportsStrong.AllAssemblyResolutions() -> r.resolvedPath |]) + TemporaryFolder = FileSystem.GetTempPathShim() + } let providers = [ @@ -1919,7 +1973,7 @@ and [] TcImports ccuinfo.TypeProviders <- tcImports.ImportTypeProviderExtensions(ctok, tcConfig, fileName, ilScopeRef, attrs, ccu.Contents, invalidateCcu, m) #endif - [ ResolvedImportedAssembly ccuinfo ] + [ ResolvedImportedAssembly(ccuinfo, m) ] phase2 @@ -2059,7 +2113,9 @@ and [] TcImports #if !NO_TYPEPROVIDERS ccuRawDataAndInfos |> List.iter (fun (_, _, phase2) -> phase2 ()) #endif - ccuRawDataAndInfos |> List.map p23 |> List.map ResolvedImportedAssembly + ccuRawDataAndInfos + |> List.map p23 + |> List.map (fun asm -> ResolvedImportedAssembly(asm, m)) phase2 @@ -2141,6 +2197,13 @@ and [] TcImports node { CheckDisposed() + let tcConfig = tcConfigP.Get ctok + + let runMethod = + match tcConfig.parallelReferenceResolution with + | ParallelReferenceResolution.On -> NodeCode.Parallel + | ParallelReferenceResolution.Off -> NodeCode.Sequential + let! results = nms |> List.map (fun nm -> @@ -2151,12 +2214,12 @@ and [] TcImports errorR (Error(FSComp.SR.buildProblemReadingAssembly (nm.resolvedPath, e.Message), nm.originalReference.Range)) return None }) - |> NodeCode.Sequential + |> runMethod - let dllinfos, phase2s = results |> Array.choose id |> List.ofArray |> List.unzip + let _dllinfos, phase2s = results |> Array.choose id |> List.ofArray |> List.unzip fixupOrphanCcus () - let ccuinfos = (List.collect (fun phase2 -> phase2 ()) phase2s) - return dllinfos, ccuinfos + let ccuinfos = List.collect (fun phase2 -> phase2 ()) phase2s + return ccuinfos } /// Note that implicit loading is not used for compilations from MSBuild, which passes ``--noframework`` @@ -2206,7 +2269,7 @@ and [] TcImports #endif /// Only used by F# Interactive - member tcImports.TryFindExistingFullyQualifiedPathBySimpleAssemblyName simpleAssemName : string option = + member _.TryFindExistingFullyQualifiedPathBySimpleAssemblyName simpleAssemName : string option = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, resolutions) @@ -2214,14 +2277,14 @@ and [] TcImports |> Option.map (fun r -> r.resolvedPath)) /// Only used by F# Interactive - member tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(assemblyRef: ILAssemblyRef) : string option = + member _.TryFindExistingFullyQualifiedPathByExactAssemblyRef(assemblyRef: ILAssemblyRef) : string option = tciLock.AcquireLock(fun tcitok -> RequireTcImportsLock(tcitok, resolutions) resolutions.TryFindByExactILAssemblyRef assemblyRef |> Option.map (fun r -> r.resolvedPath)) - member tcImports.TryResolveAssemblyReference + member _.TryResolveAssemblyReference ( ctok, assemblyReference: AssemblyReference, @@ -2318,7 +2381,7 @@ and [] TcImports let primaryScopeRef = match primaryAssem with - | _, [ ResolvedImportedAssembly ccu ] -> ccu.FSharpViewOfMetadata.ILScopeRef + | [ ResolvedImportedAssembly (ccu, _) ] -> ccu.FSharpViewOfMetadata.ILScopeRef | _ -> failwith "primaryScopeRef - unexpected" let resolvedAssemblies = tcResolutions.GetAssemblyResolutions() @@ -2379,7 +2442,7 @@ and [] TcImports match resolvedAssemblyRef with | Some coreLibraryResolution -> match! frameworkTcImports.RegisterAndImportReferencedAssemblies(ctok, [ coreLibraryResolution ]) with - | _, [ ResolvedImportedAssembly fslibCcuInfo ] -> + | [ ResolvedImportedAssembly (fslibCcuInfo, _) ] -> return fslibCcuInfo.FSharpViewOfMetadata, fslibCcuInfo.ILScopeRef | _ -> return @@ -2433,7 +2496,7 @@ and [] TcImports return tcGlobals, frameworkTcImports } - member tcImports.ReportUnresolvedAssemblyReferences knownUnresolved = + member _.ReportUnresolvedAssemblyReferences knownUnresolved = // Report that an assembly was not resolved. let reportAssemblyNotResolved (file, originalReferences: AssemblyReference list) = originalReferences @@ -2493,43 +2556,34 @@ and [] TcImports } interface IDisposable with - member tcImports.Dispose() = dispose () + member _.Dispose() = dispose () override tcImports.ToString() = "TcImports(...)" /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, referenceRange, file) = - let resolutions = - CommitOperationResult( - tcImports.TryResolveAssemblyReference( - ctok, - AssemblyReference(referenceRange, file, None), - ResolveAssemblyReferenceMode.ReportErrors - ) - ) +let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, resolutions) = - let dllinfos, ccuinfos = + let ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> NodeCode.RunImmediateWithoutCancellation let asms = ccuinfos |> List.map (function - | ResolvedImportedAssembly asm -> asm - | UnresolvedImportedAssembly assemblyName -> - error (Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile (assemblyName, file), referenceRange))) + | ResolvedImportedAssembly (asm, m) -> asm, m + | UnresolvedImportedAssembly (assemblyName, m) -> error (Error(FSComp.SR.buildCouldNotResolveAssembly (assemblyName), m))) let g = tcImports.GetTcGlobals() let amap = tcImports.GetImportMap() let _openDecls, tcEnv = (tcEnv, asms) - ||> List.collectFold (fun tcEnv asm -> + ||> List.collectFold (fun tcEnv (asm, m) -> AddCcuToTcEnv( g, amap, - referenceRange, + m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, @@ -2537,4 +2591,6 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, referenceRa asm.AssemblyInternalsVisibleToAttributes )) - tcEnv, (dllinfos, asms) + let asms = asms |> List.map fst + + tcEnv, asms diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index d6be5bbd60b..30bb4333f77 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -208,13 +208,12 @@ type TcImports = static member BuildTcImports: tcConfigP: TcConfigProvider * dependencyProvider: DependencyProvider -> NodeCode -/// Process #r in F# Interactive. +/// Process a group of #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -val RequireDLL: +val RequireReferences: ctok: CompilationThreadToken * tcImports: TcImports * tcEnv: TcEnv * thisAssemblyName: string * - referenceRange: range * - file: string -> - TcEnv * (ImportedBinary list * ImportedAssembly list) + resolutions: AssemblyResolution list -> + TcEnv * ImportedAssembly list diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 2a950193cc1..d775442d379 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -257,7 +257,7 @@ module ResponseFile = Choice2Of2 e let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: CompilerOptionBlock list, args) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let specs = List.collect GetOptionsOfBlock blocks @@ -1387,6 +1387,7 @@ let testFlag tcConfigB = | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true | "ParallelOff" -> tcConfigB.concurrentBuild <- false + | "ParallelCheckingWithSignatureFilesOn" -> tcConfigB.parallelCheckingWithSignatureFiles <- true #if DEBUG | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true #endif @@ -1679,6 +1680,14 @@ let internalFlags (tcConfigB: TcConfigBuilder) = None ) + CompilerOption( + "parallelreferenceresolution", + tagNone, + OptionUnit(fun () -> tcConfigB.parallelReferenceResolution <- ParallelReferenceResolution.On), + Some(InternalCommandLineOption("--parallelreferenceresolution", rangeCmdArgs)), + None + ) + testFlag tcConfigB ] @ @@ -2304,13 +2313,14 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = //---------------------------------------------------------------------------- let mutable tPrev: (DateTime * DateTime * float * int[]) option = None -let mutable nPrev: string option = None +let mutable nPrev: (string * IDisposable) option = None let ReportTime (tcConfig: TcConfig) descr = - match nPrev with | None -> () - | Some prevDescr -> + | Some (prevDescr, prevActivity) -> + use _ = prevActivity // Finish the previous diagnostics activity by .Dispose() at the end of this block + if tcConfig.pause then dprintf "[done '%s', entering '%s'] press to continue... " prevDescr descr Console.ReadLine() |> ignore @@ -2349,7 +2359,7 @@ let ReportTime (tcConfig: TcConfig) descr = let tStart = match tPrev, nPrev with - | Some (tStart, tPrev, utPrev, gcPrev), Some prevDescr -> + | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, _) -> let spanGC = [| for i in 0..maxGen -> GC.CollectionCount i - gcPrev[i] |] let t = tNow - tStart let tDelta = tNow - tPrev @@ -2376,7 +2386,7 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) - nPrev <- Some descr + nPrev <- Some(descr, Activity.StartNoTags descr) let ignoreFailureOnMono1_1_16 f = try diff --git a/src/Compiler/Driver/FxResolver.fs b/src/Compiler/Driver/FxResolver.fs index 2fa595ee15b..ce2474a7085 100644 --- a/src/Compiler/Driver/FxResolver.fs +++ b/src/Compiler/Driver/FxResolver.fs @@ -611,7 +611,7 @@ type internal FxResolver // A set of assemblies to always consider to be system assemblies. A common set of these can be used a shared // resources between projects in the compiler services. Also all assemblies where well-known system types exist // referenced from TcGlobals must be listed here. - let systemAssemblies = + static let systemAssemblies = HashSet [ // NOTE: duplicates are ok in this list @@ -789,17 +789,10 @@ type internal FxResolver "WindowsBase" ] - member _.GetSystemAssemblies() = systemAssemblies + static member GetSystemAssemblies() = systemAssemblies - member _.IsInReferenceAssemblyPackDirectory fileName = - fxlock.AcquireLock(fun fxtok -> - RequireFxResolverLock(fxtok, "assuming all member require lock") - - match tryGetNetCoreRefsPackDirectoryRoot () |> replayWarnings with - | _, Some root -> - let path = Path.GetDirectoryName(fileName) - path.StartsWith(root, StringComparison.OrdinalIgnoreCase) - | _ -> false) + static member IsReferenceAssemblyPackDirectoryApprox(dirName: string) = + dirName.Contains "Microsoft.NETCore.App.Ref" member _.TryGetSdkDir() = fxlock.AcquireLock(fun fxtok -> diff --git a/src/Compiler/Driver/FxResolver.fsi b/src/Compiler/Driver/FxResolver.fsi index 2bca0a75d8c..d740d2fc497 100644 --- a/src/Compiler/Driver/FxResolver.fsi +++ b/src/Compiler/Driver/FxResolver.fsi @@ -28,12 +28,14 @@ type internal FxResolver = member GetFrameworkRefsPackDirectory: unit -> string option - member GetSystemAssemblies: unit -> HashSet + static member GetSystemAssemblies: unit -> HashSet /// Gets the selected target framework moniker, e.g netcore3.0, net472, and the running rid of the current machine member GetTfmAndRid: unit -> string * string - member IsInReferenceAssemblyPackDirectory: fileName: string -> bool + /// Determines if an assembly is in the core set of assemblies with high likelihood of + /// being shared amongst a set of common scripting references + static member IsReferenceAssemblyPackDirectoryApprox: dirName: string -> bool member TryGetDesiredDotNetSdkVersionForDirectory: unit -> Result diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 33a5c08a031..42b5d802b05 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -216,11 +216,6 @@ let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, fileName, intf) SynModuleOrNamespaceSig(lid, isRecursive, kind, decls, xmlDoc, attributes, None, range, trivia) -let GetScopedPragmasForInput input = - match input with - | ParsedInput.SigFile (ParsedSigFileInput (scopedPragmas = pragmas)) -> pragmas - | ParsedInput.ImplFile (ParsedImplFileInput (scopedPragmas = pragmas)) -> pragmas - let GetScopedPragmasForHashDirective hd = [ match hd with @@ -427,8 +422,8 @@ let ParseInput // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file let delayLogger = CapturingDiagnosticsLogger("Parsing") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayLogger) - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseDiagnosticsLogger delayLogger + use _ = UseBuildPhase BuildPhase.Parse let mutable scopedPragmas = [] @@ -460,7 +455,7 @@ let ParseInput else error (Error(FSComp.SR.buildInvalidSourceFileExtension fileName, rangeStartup)) - scopedPragmas <- GetScopedPragmasForInput input + scopedPragmas <- input.ScopedPragmas input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped @@ -490,7 +485,6 @@ let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, while true do match (Parser.interaction (fun _ -> tokenizer ()) lexbuf) with | ParsedScriptInteraction.Definitions (l, m) -> printfn "Parsed OK, got %d defs @ %a" l.Length outputRange m - | ParsedScriptInteraction.HashDirective (_, m) -> printfn "Parsed OK, got hash @ %a" outputRange m exiter.Exit 0 @@ -512,10 +506,8 @@ let ReportParsingStatistics res = let flattenModImpl (SynModuleOrNamespace (decls = decls)) = flattenDefns decls match res with - | ParsedInput.SigFile (ParsedSigFileInput (modules = specs)) -> - printfn "parsing yielded %d specs" (List.collect flattenModSpec specs).Length - | ParsedInput.ImplFile (ParsedImplFileInput (modules = impls)) -> - printfn "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length + | ParsedInput.SigFile sigFile -> printfn "parsing yielded %d specs" (List.collect flattenModSpec sigFile.Contents).Length + | ParsedInput.ImplFile implFile -> printfn "parsing yielded %d definitions" (List.collect flattenModImpl implFile.Contents).Length let EmptyParsedInput (fileName, isLastCompiland) = if FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then @@ -551,7 +543,7 @@ let EmptyParsedInput (fileName, isLastCompiland) = /// Parse an input, drawing tokens from the LexBuffer let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileName, isLastCompiland, diagnosticsLogger) = - use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use unwindbuildphase = UseBuildPhase BuildPhase.Parse try @@ -735,74 +727,71 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC errorRecovery exn rangeStartup EmptyParsedInput(fileName, isLastCompiland) -/// Parse multiple input files from disk -let ParseInputFiles - ( - tcConfig: TcConfig, - lexResourceManager, - sourceFiles, - diagnosticsLogger: DiagnosticsLogger, - createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, - retryLocked - ) = +/// Prepare to process inputs independently, e.g. partially in parallel. +/// +/// To do this we create one CapturingDiagnosticLogger for each input and +/// then ensure the diagnostics are presented in deterministic order after processing completes. +/// On completion all diagnostics are forwarded to the DiagnosticLogger given as input. +/// +/// NOTE: Max errors is currently counted separately for each logger. When max errors is reached on one compilation +/// the given Exiter will be called. +/// +/// NOTE: this needs to be improved to commit diagnotics as soon as possible +/// +/// NOTE: If StopProcessing is raised by any piece of work then the overall function raises StopProcessing. +let UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, eagerFormat) f = + + // Check input files and create delayed error loggers before we try to parallel parse. + let delayLoggers = + inputs + |> List.map (fun _ -> CapturingDiagnosticsLogger("TcDiagnosticsLogger", ?eagerFormat = eagerFormat)) + try - let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList + f (List.zip inputs delayLoggers) + finally + for logger in delayLoggers do + logger.CommitDelayedDiagnostics diagnosticsLogger - if tcConfig.concurrentBuild then - let mutable exitCode = 0 +let ParseInputFilesInParallel (tcConfig: TcConfig, lexResourceManager, sourceFiles, delayLogger: DiagnosticsLogger, retryLocked) = - let delayedExiter = - { new Exiter with - member _.Exit n = - exitCode <- n - raise StopProcessing - } + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - // Check input files and create delayed error loggers before we try to parallel parse. - let delayedDiagnosticsLoggers = - sourceFiles - |> Array.map (fun (fileName, _) -> - checkInputFile tcConfig fileName - createDiagnosticsLogger delayedExiter) - - let results = - try - try - sourceFiles - |> ArrayParallel.mapi (fun i (fileName, isLastCompiland) -> - let delayedDiagnosticsLogger = delayedDiagnosticsLoggers[i] - - let directoryName = Path.GetDirectoryName fileName - - let input = - parseInputFileAux ( - tcConfig, - lexResourceManager, - fileName, - (isLastCompiland, isExe), - delayedDiagnosticsLogger, - retryLocked - ) - - (input, directoryName)) - finally - delayedDiagnosticsLoggers - |> Array.iter (fun delayedDiagnosticsLogger -> delayedDiagnosticsLogger.CommitDelayedDiagnostics diagnosticsLogger) - with StopProcessing -> - tcConfig.exiter.Exit exitCode - - results |> List.ofArray - else - sourceFiles - |> Array.map (fun (fileName, isLastCompiland) -> - let directoryName = Path.GetDirectoryName fileName + for fileName in sourceFiles do + checkInputFile tcConfig fileName + + let sourceFiles = List.zip sourceFiles isLastCompiland + + UseMultipleDiagnosticLoggers (sourceFiles, delayLogger, None) (fun sourceFilesWithDelayLoggers -> + sourceFilesWithDelayLoggers + |> ListParallel.map (fun ((fileName, isLastCompiland), delayLogger) -> + let directoryName = Path.GetDirectoryName fileName - let input = - ParseOneInputFile(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), diagnosticsLogger, retryLocked) + let input = + parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayLogger, retryLocked) - (input, directoryName)) - |> List.ofArray + (input, directoryName))) + +let ParseInputFilesSequential (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) = + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint + let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList + + sourceFiles + |> Array.map (fun (fileName, isLastCompiland) -> + let directoryName = Path.GetDirectoryName fileName + + let input = + ParseOneInputFile(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), diagnosticsLogger, retryLocked) + + (input, directoryName)) + |> List.ofArray + +/// Parse multiple input files from disk +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) = + try + if tcConfig.concurrentBuild then + ParseInputFilesInParallel(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked) + else + ParseInputFilesSequential(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked) with e -> errorRecoveryNoRange e @@ -815,12 +804,12 @@ let ProcessMetaCommandsFromInput (tcConfig: TcConfigBuilder, inp: ParsedInput, pathOfMetaCommandSource, state0) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse let canHaveScriptMetaCommands = match inp with | ParsedInput.SigFile _ -> false - | ParsedInput.ImplFile (ParsedImplFileInput (isScript = isScript)) -> isScript + | ParsedInput.ImplFile file -> file.IsScript let ProcessDependencyManagerDirective directive args m state = if not canHaveScriptMetaCommands then @@ -856,10 +845,7 @@ let ProcessMetaCommandsFromInput | ParsedHashDirective ("nowarn", ParsedHashDirectiveArguments numbers, m) -> List.fold (fun state d -> nowarnF state (m, d)) state numbers - | ParsedHashDirective (("reference" - | "r"), - ParsedHashDirectiveArguments args, - m) -> + | ParsedHashDirective (("reference" | "r"), ParsedHashDirectiveArguments args, m) -> matchedm <- m ProcessDependencyManagerDirective Directive.Resolution args m state @@ -938,13 +924,13 @@ let ProcessMetaCommandsFromInput decls match inp with - | ParsedInput.SigFile (ParsedSigFileInput (hashDirectives = hashDirectives; modules = specs)) -> - let state = List.fold ProcessMetaCommand state0 hashDirectives - let state = List.fold ProcessMetaCommandsFromModuleSpec state specs + | ParsedInput.SigFile sigFile -> + let state = List.fold ProcessMetaCommand state0 sigFile.HashDirectives + let state = List.fold ProcessMetaCommandsFromModuleSpec state sigFile.Contents state - | ParsedInput.ImplFile (ParsedImplFileInput (hashDirectives = hashDirectives; modules = impls)) -> - let state = List.fold ProcessMetaCommand state0 hashDirectives - let state = List.fold ProcessMetaCommandsFromModuleImpl state impls + | ParsedInput.ImplFile implFile -> + let state = List.fold ProcessMetaCommand state0 implFile.HashDirectives + let state = List.fold ProcessMetaCommandsFromModuleImpl state implFile.Contents state let ApplyNoWarnsToTcConfig (tcConfig: TcConfig, inp: ParsedInput, pathOfMetaCommandSource) = @@ -1034,22 +1020,34 @@ let qnameOrder = Order.orderBy (fun (q: QualifiedNameOfFile) -> q.Text) type TcState = { + /// The assembly thunk for the assembly being compiled. tcsCcu: CcuThunk - tcsCcuType: ModuleOrNamespace - tcsNiceNameGen: NiceNameGenerator + + /// The typing environment implied by the set of signature files and/or inferred signatures of implementation files checked so far tcsTcSigEnv: TcEnv + + /// The typing environment implied by the set of implementation files checked so far tcsTcImplEnv: TcEnv + + /// Indicates if any implementation file so far includes use of generative provided types tcsCreatesGeneratedProvidedTypes: bool + + /// A table of signature files processed so far, indexed by QualifiedNameOfFile, to help give better diagnostics + /// if there are mismatches in module names between signature and implementation files with the same name. tcsRootSigs: RootSigs + + /// A table of implementation files processed so far, indexed by QualifiedNameOfFile, to help give better diagnostics + /// if there are mismatches in module names between signature and implementation files with the same name. tcsRootImpls: RootImpls + + /// The combined partial assembly signature resulting from all the signatures and/or inferred signatures of implementation files + /// so far. tcsCcuSig: ModuleOrNamespaceType - /// The collected open declarations implied by '/checked' flag and processing F# interactive fragments that have an implied module. + /// The collected implicit open declarations implied by '/checked' flag and processing F# interactive fragments that have an implied module. tcsImplicitOpenDeclarations: OpenDeclaration list } - member x.NiceNameGenerator = x.tcsNiceNameGen - member x.TcEnvFromSignatures = x.tcsTcSigEnv member x.TcEnvFromImpls = x.tcsTcImplEnv @@ -1058,9 +1056,6 @@ type TcState = member x.CreatesGeneratedProvidedTypes = x.tcsCreatesGeneratedProvidedTypes - // Assem(a.fsi + b.fsi + c.fsi) (after checking implementation file ) - member x.CcuType = x.tcsCcuType - // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) member x.CcuSig = x.tcsCcuSig @@ -1071,7 +1066,7 @@ type TcState = } /// Create the initial type checking state for compiling an assembly -let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, niceNameGen, tcEnv0, openDecls0) = +let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, tcEnv0, openDecls0) = ignore tcImports // Create a ccu to hold all the results of compilation @@ -1107,8 +1102,6 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI { tcsCcu = ccu - tcsCcuType = ccuContents - tcsNiceNameGen = niceNameGen tcsTcSigEnv = tcEnv0 tcsTcImplEnv = tcEnv0 tcsCreatesGeneratedProvidedTypes = false @@ -1120,10 +1113,77 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI /// Dummy typed impl file that contains no definitions and is not used for emitting any kind of assembly. let CreateEmptyDummyImplFile qualNameOfFile sigTy = - CheckedImplFile.CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + +let AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcImplEnv, qualNameOfFile, implFileSigType) + (tcState: TcState) + = + + let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls + + // Only add it to the environment if it didn't have a signature + let m = qualNameOfFile.Range + + // Add the implementation as to the implementation env + let tcImplEnv = + AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType + + // Add the implementation as to the signature env (unless it had an explicit signature) + let tcSigEnv = + if hadSig then + tcState.tcsTcSigEnv + else + AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType + + // Open the prefixPath for fsi.exe (tcImplEnv) + let tcImplEnv, openDecls = + match prefixPathOpt with + | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcImplEnv (prefixPath, m) + | _ -> tcImplEnv, [] + + // Open the prefixPath for fsi.exe (tcSigEnv) + let tcSigEnv, _ = + match prefixPathOpt with + | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcSigEnv (prefixPath, m) + | _ -> tcSigEnv, [] + + let ccuSigForFile = + CombineCcuContentFragments [ implFileSigType; tcState.tcsCcuSig ] + + let tcState = + { tcState with + tcsTcSigEnv = tcSigEnv + tcsTcImplEnv = tcImplEnv + tcsRootImpls = rootImpls + tcsCcuSig = ccuSigForFile + tcsImplicitOpenDeclarations = tcState.tcsImplicitOpenDeclarations @ openDecls + } + + ccuSigForFile, tcState + +let AddDummyCheckResultsToTcState + ( + tcGlobals, + amap, + qualName: QualifiedNameOfFile, + prefixPathOpt, + tcSink, + tcState: TcState, + tcStateForImplFile: TcState, + rootSig + ) = + let hadSig = true + let emptyImplFile = CreateEmptyDummyImplFile qualName rootSig + let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + + let ccuSigForFile, tcState = + AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualName, rootSig) tcState + + (tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState /// Typecheck a single file (or interactive entry into F# Interactive) -let CheckOneInput +let CheckOneInputAux ( checkForErrors, tcConfig: TcConfig, @@ -1138,7 +1198,8 @@ let CheckOneInput cancellable { try - use _ = Activity.instance.Start "CheckOneInput" [| "inputName", inp.FileName |] + use _ = + Activity.Start "ParseAndCheckInputs.CheckOneInput" [| "inputName", inp.FileName |] CheckSimulateException tcConfig @@ -1146,7 +1207,9 @@ let CheckOneInput let amap = tcImports.GetImportMap() match inp with - | ParsedInput.SigFile (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile) as file) -> + | ParsedInput.SigFile file -> + + let qualNameOfFile = file.QualifiedName // Check if we've seen this top module signature before. if Zmap.mem qualNameOfFile tcState.tcsRootSigs then @@ -1166,7 +1229,6 @@ let CheckOneInput let! tcEnv, sigFileType, createsGeneratedProvidedTypes = CheckOneSigFile (tcGlobals, - tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, @@ -1179,7 +1241,7 @@ let CheckOneInput let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs // Add the signature to the signature env (unless it had an explicit signature) - let ccuSigForFile = CombineCcuContentFragments m [ sigFileType; tcState.tcsCcuSig ] + let ccuSigForFile = CombineCcuContentFragments [ sigFileType; tcState.tcsCcuSig ] // Open the prefixPath for fsi.exe let tcEnv, _openDecls1 = @@ -1197,9 +1259,10 @@ let CheckOneInput tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes } - return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState + return Choice1Of2(tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState - | ParsedInput.ImplFile (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile) as file) -> + | ParsedInput.ImplFile file -> + let qualNameOfFile = file.QualifiedName // Check if we've got an interface for this fragment let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile @@ -1208,8 +1271,6 @@ let CheckOneInput if Zset.contains qualNameOfFile tcState.tcsRootImpls then errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m)) - let tcImplEnv = tcState.tcsTcImplEnv - let conditionalDefines = if tcConfig.noConditionalErasure then None @@ -1218,15 +1279,30 @@ let CheckOneInput let hadSig = rootSigOpt.IsSome - // Typecheck the implementation file - let typeCheckOne = - if skipImplIfSigExists && hadSig then - (EmptyTopAttrs, CreateEmptyDummyImplFile qualNameOfFile rootSigOpt.Value, Unchecked.defaultof<_>, tcImplEnv, false) - |> cancellable.Return - else + match rootSigOpt with + | Some rootSig when skipImplIfSigExists -> + // Delay the typecheck the implementation file until the second phase of parallel processing. + // Adjust the TcState as if it has been checked, which makes the signature for the file available later + // in the compilation order. + let tcStateForImplFile = tcState + let qualNameOfFile = file.QualifiedName + let priorErrors = checkForErrors () + + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) + tcState + + let partialResult = + (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) + + return Choice2Of2 partialResult, tcState + + | _ -> + // Typecheck the implementation file + let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = CheckOneImplFile( tcGlobals, - tcState.tcsNiceNameGen, amap, tcState.tcsCcu, tcState.tcsImplicitOpenDeclarations, @@ -1234,75 +1310,78 @@ let CheckOneInput conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring, - tcImplEnv, + tcState.tcsTcImplEnv, rootSigOpt, file ) - let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = typeCheckOne - - let implFileSigType = implFile.Signature - - let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls - - // Only add it to the environment if it didn't have a signature - let m = qualNameOfFile.Range - - // Add the implementation as to the implementation env - let tcImplEnv = - AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType - - // Add the implementation as to the signature env (unless it had an explicit signature) - let tcSigEnv = - if hadSig then - tcState.tcsTcSigEnv - else - AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType - - // Open the prefixPath for fsi.exe (tcImplEnv) - let tcImplEnv, openDecls = - match prefixPathOpt with - | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcImplEnv (prefixPath, m) - | _ -> tcImplEnv, [] + let tcState = + { tcState with + tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes + } - // Open the prefixPath for fsi.exe (tcSigEnv) - let tcSigEnv, _ = - match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcSigEnv (prefixPath, m) - | _ -> tcSigEnv, [] + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature) + tcState - let ccuSigForFile = - CombineCcuContentFragments m [ implFileSigType; tcState.tcsCcuSig ] - - let tcState = - { tcState with - tcsTcSigEnv = tcSigEnv - tcsTcImplEnv = tcImplEnv - tcsRootImpls = rootImpls - tcsCcuSig = ccuSigForFile - tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes - tcsImplicitOpenDeclarations = tcState.tcsImplicitOpenDeclarations @ openDecls - } - - return (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile), tcState + let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) + return Choice1Of2 result, tcState with e -> errorRecovery e range0 - return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState + return Choice1Of2(tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState } +/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true +/// then implementations with signature files give empty results. +let CheckOneInput + ( + checkForErrors, + tcConfig: TcConfig, + tcImports: TcImports, + tcGlobals, + prefixPathOpt, + tcSink, + tcState: TcState, + input: ParsedInput, + skipImplIfSigExists: bool + ) = + cancellable { + let! partialResult, tcState = + CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists) + + match partialResult with + | Choice1Of2 result -> return result, tcState + | Choice2Of2 (amap, _conditionalDefines, rootSig, _priorErrors, file, tcStateForImplFile, _ccuSigForFile) -> + return + AddDummyCheckResultsToTcState( + tcGlobals, + amap, + file.QualifiedName, + prefixPathOpt, + tcSink, + tcState, + tcStateForImplFile, + rootSig + ) + } + +// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input +let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger) = + GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, oldLogger) + /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState (inp: ParsedInput) = - // 'use' ensures that the warning handler is restored at the end - use unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun oldLogger -> - GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.diagnosticsOptions, oldLogger)) +let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, skipImplIfSigExists) tcState input = + // Equip loggers to locally filter w.r.t. scope pragmas in each input + use _ = + UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use _ = UseBuildPhase BuildPhase.TypeCheck RequireCompilationThread ctok - CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) + CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, skipImplIfSigExists) |> Cancellable.runWithoutCancellation /// Finish checking multiple files (or one interactive entry into F# Interactive) @@ -1320,11 +1399,9 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = cancellable { - Logger.LogBlockStart LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually - let! results, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) - let result = CheckMultipleInputsFinish([ results ], tcState) - Logger.LogBlockStop LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually - return result + let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + let finishedResult = CheckMultipleInputsFinish([ result ], tcState) + return finishedResult } let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = @@ -1340,12 +1417,129 @@ let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = tcState, declaredImpls, ccuContents -let CheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - use tcActivity = Activity.instance.StartNoTags("CheckClosedInputSet") +let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = + (tcState, inputs) + ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, false)) + +/// Use parallel checking of implementation files that have signature files +let CheckMultipleInputsInParallel + ( + ctok, + checkForErrors, + tcConfig: TcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + tcState, + eagerFormat, + inputs + ) = + + let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger + + // We create one CapturingDiagnosticLogger for each file we are processing and + // ensure the diagnostics are presented in deterministic order. + // + // eagerFormat is used to format diagnostics as they are emitted, just as they would be in the command-line + // compiler. This is necessary because some formatting of diagnostics is dependent on the + // type inference state at precisely the time the diagnostic is emitted. + UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, Some eagerFormat) (fun inputsWithLoggers -> + + // Equip loggers to locally filter w.r.t. scope pragmas in each input + let inputsWithLoggers = + inputsWithLoggers + |> List.map (fun (input, oldLogger) -> + let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger) + input, logger) + + // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors + // somewhere in the files processed prior to each one, or in the processing of this particular file. + let priorErrors = checkForErrors () + + // Do the first linear phase, checking all signatures and any implementation files that don't have a signature. + // Implementation files that do have a signature will result in a Choice2Of2 indicating to next do some of the + // checking in parallel. + let partialResults, (tcState, _) = + ((tcState, priorErrors), inputsWithLoggers) + ||> List.mapFold (fun (tcState, priorErrors) (input, logger) -> + use _ = UseDiagnosticsLogger logger + + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) + + let partialResult, tcState = + CheckOneInputAux( + checkForErrors2, + tcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + TcResultsSink.NoSink, + tcState, + input, + true + ) + |> Cancellable.runWithoutCancellation + + let priorErrors = checkForErrors2 () + partialResult, (tcState, priorErrors)) + + // Do the parallel phase, checking all implementation files that did have a signature, in parallel. + let results, createsGeneratedProvidedTypesFlags = + + List.zip partialResults inputsWithLoggers + |> List.toArray + |> ArrayParallel.map (fun (partialResult, (_, logger)) -> + use _ = UseDiagnosticsLogger logger + use _ = UseBuildPhase BuildPhase.TypeCheck + + RequireCompilationThread ctok + + match partialResult with + | Choice1Of2 result -> result, false + | Choice2Of2 (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) -> + + // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors + // somewhere in the files processed prior to this one, including from the first phase, or in the processing + // of this particular file. + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) + + let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = + CheckOneImplFile( + tcGlobals, + amap, + tcStateForImplFile.tcsCcu, + tcStateForImplFile.tcsImplicitOpenDeclarations, + checkForErrors2, + conditionalDefines, + TcResultsSink.NoSink, + tcConfig.internalTestSpanStackReferring, + tcStateForImplFile.tcsTcImplEnv, + Some rootSig, + file + ) + |> Cancellable.runWithoutCancellation + + let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) + result, createsGeneratedProvidedTypes) + |> Array.toList + |> List.unzip + + let tcState = + { tcState with + tcsCreatesGeneratedProvidedTypes = + tcState.tcsCreatesGeneratedProvidedTypes + || (createsGeneratedProvidedTypesFlags |> List.exists id) + } + + results, tcState) + +let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = - (tcState, inputs) - ||> List.mapFold (TypeCheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + if tcConfig.parallelCheckingWithSignatureFiles then + CheckMultipleInputsInParallel(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) + else + CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = CheckMultipleInputsFinish(results, tcState) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index b0213532030..166191d363e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -54,8 +54,6 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe /// Process the #nowarn in an input and integrate them into the TcConfig val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig -val GetScopedPragmasForInput: input: ParsedInput -> ScopedPragma list - /// Parse one input stream val ParseOneInputStream: tcConfig: TcConfig * @@ -104,7 +102,6 @@ val ParseInputFiles: lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * diagnosticsLogger: DiagnosticsLogger * - createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * retryLocked: bool -> (ParsedInput * string) list @@ -115,7 +112,6 @@ val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlo /// Represents the incremental type checking state for a set of inputs [] type TcState = - member NiceNameGenerator: NiceNameGenerator /// The CcuThunk for the current assembly being checked member Ccu: CcuThunk @@ -135,19 +131,18 @@ type TcState = member CreatesGeneratedProvidedTypes: bool /// Get the initial type checking state for a set of inputs -val GetInitialTcState: - range * string * TcConfig * TcGlobals * TcImports * NiceNameGenerator * TcEnv * OpenDeclaration list -> TcState +val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState /// Check one input, returned as an Eventually computation val CheckOneInput: checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - NameResolution.TcResultsSink * - TcState * - ParsedInput * + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcSink: NameResolution.TcResultsSink * + tcState: TcState * + input: ParsedInput * skipImplIfSigExists: bool -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> @@ -160,24 +155,25 @@ val CheckClosedInputSetFinish: CheckedImplFile list * TcState -> TcState * Check /// Check a closed set of inputs val CheckClosedInputSet: - CompilationThreadToken * + ctok: CompilationThreadToken * checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - TcState * - ParsedInput list -> + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcState: TcState * + eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic) * + inputs: ParsedInput list -> TcState * TopAttribs * CheckedImplFile list * TcEnv /// Check a single input and finish the checking val CheckOneInputAndFinish: checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - NameResolution.TcResultsSink * - TcState * - ParsedInput -> + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcSink: NameResolution.TcResultsSink * + tcState: TcState * + input: ParsedInput -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 868a9f80cae..74a4c083a7d 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -196,7 +196,7 @@ module ScriptPreprocessClosure = match basicReferences with | None -> let diagnosticsLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib @@ -451,7 +451,7 @@ module ScriptPreprocessClosure = if IsScript fileName || parseRequired then let parseResult, parseDiagnostics = let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureParse") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let result = ParseScriptClosureInput(fileName, sourceText, tcConfig, codeContext, lexResourceManager, diagnosticsLogger) @@ -459,7 +459,7 @@ module ScriptPreprocessClosure = result, diagnosticsLogger.Diagnostics let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let pathOfMetaCommandSource = Path.GetDirectoryName fileName let preSources = tcConfig.GetAvailableLoadedSources() @@ -569,7 +569,7 @@ module ScriptPreprocessClosure = let references, unresolvedReferences, resolutionDiagnostics = let diagnosticsLogger = CapturingDiagnosticsLogger("GetLoadClosure") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig) @@ -585,8 +585,8 @@ module ScriptPreprocessClosure = (parseDiagnostics @ earlierDiagnostics @ metaDiagnostics @ resolutionDiagnostics) | _ -> [], [] // When no file existed. - let isRootRange exn = - match GetRangeOfDiagnostic exn with + let isRootRange (diagnostic: PhasedDiagnostic) = + match diagnostic.Range with | Some m -> // Return true if the error was *not* from a #load-ed file. let isArgParameterWhileNotEditing = @@ -745,7 +745,7 @@ type LoadClosure with dependencyProvider ) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptText( legacyReferenceResolver, @@ -775,5 +775,5 @@ type LoadClosure with dependencyProvider ) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 0e9186b9311..e8ec56fa5a5 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -68,7 +68,7 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, let mutable errors = 0 /// Called when an error or warning occurs - abstract HandleIssue: tcConfigB: TcConfigBuilder * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + abstract HandleIssue: tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit @@ -76,12 +76,14 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, override _.ErrorCount = errors override x.DiagnosticSink(diagnostic, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (diagnostic, severity) then - if errors >= tcConfigB.maxErrors then + let tcConfig = TcConfig.Create(tcConfigB, validate = false) + + if diagnostic.ReportAsError(tcConfig.diagnosticsOptions, severity) then + if errors >= tcConfig.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors ()) exiter.Exit 1 - x.HandleIssue(tcConfigB, diagnostic, FSharpDiagnosticSeverity.Error) + x.HandleIssue(tcConfig, diagnostic, FSharpDiagnosticSeverity.Error) errors <- errors + 1 @@ -92,60 +94,47 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (diagnostic.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (diagnostic, severity) then - x.HandleIssue(tcConfigB, diagnostic, FSharpDiagnosticSeverity.Warning) + elif diagnostic.ReportAsWarning(tcConfig.diagnosticsOptions, severity) then + x.HandleIssue(tcConfig, diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (diagnostic, severity) then - x.HandleIssue(tcConfigB, diagnostic, severity) + elif diagnostic.ReportAsInfo(tcConfig.diagnosticsOptions, severity) then + x.HandleIssue(tcConfig, diagnostic, severity) /// Create an error logger that counts and prints errors -let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter: Exiter) = - { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLoggerUpToMaxErrors") with +let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLogger") with member _.HandleTooManyErrors(text: string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) - member _.HandleIssue(tcConfigB, err, severity) = + member _.HandleIssue(tcConfig, diagnostic, severity) = DoWithDiagnosticColor severity (fun () -> - let diagnostic = - OutputDiagnostic( - tcConfigB.implicitIncludeDir, - tcConfigB.showFullPaths, - tcConfigB.flatErrors, - tcConfigB.diagnosticStyle, - severity - ) - - writeViaBuffer stderr diagnostic err + writeViaBuffer stderr (fun buf -> diagnostic.Output(buf, tcConfig, severity)) stderr.WriteLine()) } :> DiagnosticsLogger -/// This error logger delays the messages it receives. At the end, call ForwardDelayedDiagnostics -/// to send the held messages. -type DelayAndForwardDiagnosticsLogger(exiter: Exiter, diagnosticsLoggerProvider: DiagnosticsLoggerProvider) = - inherit CapturingDiagnosticsLogger("DelayAndForwardDiagnosticsLogger") - - member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) - - x.CommitDelayedDiagnostics diagnosticsLogger +/// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking +/// of the flags themselves we have to create temporary loggers, until the full configuration is +/// available. +type IDiagnosticsLoggerProvider = -and [] DiagnosticsLoggerProvider() = + abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger - member this.CreateDelayAndForwardLogger exiter = - DelayAndForwardDiagnosticsLogger(exiter, this) +type CapturingDiagnosticsLogger with - abstract CreateDiagnosticsLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger + /// Commit the delayed diagnostics via a fresh temporary logger of the right kind. + member x.CommitDelayedDiagnostics(diagnosticsLoggerProvider: IDiagnosticsLoggerProvider, tcConfigB, exiter) = + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) + x.CommitDelayedDiagnostics diagnosticsLogger /// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - inherit DiagnosticsLoggerProvider() + interface IDiagnosticsLoggerProvider with - override _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) + member _.CreateLogger(tcConfigB, exiter) = + ConsoleDiagnosticsLogger(tcConfigB, exiter) /// Notify the exiter if any error has occurred let AbortOnError (diagnosticsLogger: DiagnosticsLogger, exiter: Exiter) = @@ -160,15 +149,11 @@ let TypeCheck tcGlobals, diagnosticsLogger: DiagnosticsLogger, assemblyName, - niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter ) = - use _ = - Activity.instance.Start "typecheck_inputs" [| "assemblyName", assemblyName |] - try if isNil inputs then error (Error(FSComp.SR.fscNoImplementationFiles (), rangeStartup)) @@ -176,16 +161,19 @@ let TypeCheck let ccuName = assemblyName let tcInitialState = - GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv0, openDecls0) + GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) + + let eagerFormat (diag: PhasedDiagnostic) = diag.EagerlyFormatCore true CheckClosedInputSet( ctok, - (fun () -> diagnosticsLogger.ErrorCount > 0), + diagnosticsLogger.CheckForErrors, tcConfig, tcImports, tcGlobals, None, tcInitialState, + eagerFormat, inputs ) with exn -> @@ -342,12 +330,12 @@ module InterfaceFileWriter = } let writeToFile os (CheckedImplFile (contents = mexpr)) = - writeViaBuffer - os - (fun os s -> Printf.bprintf os "%s\n\n" s) - (NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader AccessibleFromSomewhere range0 mexpr - |> Display.squashTo 80 - |> LayoutRender.showL) + let text = + NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader AccessibleFromSomewhere range0 mexpr + |> Display.squashTo 80 + |> LayoutRender.showL + + Printf.fprintf os "%s\n\n" text let writeHeader filePath os = if @@ -458,6 +446,18 @@ let TryFindVersionAttribute g attrib attribName attribs deterministic = [] type Args<'T> = Args of 'T +let getParallelReferenceResolutionFromEnvironment () = + Environment.GetEnvironmentVariable("FCS_ParallelReferenceResolution") + |> Option.ofObj + |> Option.bind (fun flag -> + match bool.TryParse flag with + | true, runInParallel -> + if runInParallel then + Some ParallelReferenceResolution.On + else + Some ParallelReferenceResolution.Off + | false, _ -> None) + /// First phase of compilation. /// - Set up console encoding and code page settings /// - Process command line, flags and collect filenames @@ -474,12 +474,10 @@ let main1 reduceMemoryUsage: ReduceMemoryFlag, defaultCopyFSharpCore: CopyFSharpCoreFlag, exiter: Exiter, - diagnosticsLoggerProvider: DiagnosticsLoggerProvider, + diagnosticsLoggerProvider: IDiagnosticsLoggerProvider, disposables: DisposablesTracker ) = - use mainActivity = new Activity("main") - // See Bug 735819 let lcidFromCodePage = if @@ -523,11 +521,9 @@ let main1 SetTailcallSwitch tcConfigB OptionSwitch.On // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = - diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter + let delayForFlagsLogger = CapturingDiagnosticsLogger("DelayFlagsLogger") - let _unwindEL_1 = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayForFlagsLogger) + let _holder = UseDiagnosticsLogger delayForFlagsLogger // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -536,8 +532,6 @@ let main1 // Process command line, flags and collect filenames let sourceFiles = - use parseActivity = Activity.instance.StartNoTags("determine_source_files") - // The ParseCompilerOptions function calls imperative function to process "real" args // Rather than start processing, just collect names, then process them. try @@ -545,11 +539,16 @@ let main1 AdjustForScriptCompile(tcConfigB, files, lexResourceManager, dependencyProvider) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines + // Override ParallelReferenceResolution set on the CLI with an environment setting if present. + match getParallelReferenceResolutionFromEnvironment () with + | Some parallelReferenceResolution -> tcConfigB.parallelReferenceResolution <- parallelReferenceResolution + | None -> () + // Display the banner text, if necessary if not bannerAlreadyPrinted then Console.Write(GetBannerText tcConfigB) @@ -560,30 +559,27 @@ let main1 tcConfigB.DecideNames sourceFiles with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // DecideNames may give "no inputs" error. Abort on error at this point. bug://3911 if not tcConfigB.continueAfterParseFailure && delayForFlagsLogger.ErrorCount > 0 then - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // If there's a problem building TcConfig, abort let tcConfig = - use createConfigActivity = Activity.instance.StartNoTags("create_tc_config") - try TcConfig.Create(tcConfigB, validate = false) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + let _holder = UseDiagnosticsLogger diagnosticsLogger // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics diagnosticsLogger @@ -596,14 +592,10 @@ let main1 let foundationalTcConfigP = TcConfigProvider.Constant tcConfig let sysRes, otherRes, knownUnresolved = - use splitResolutionsActivity = Activity.instance.StartNoTags("split_resolutions") TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) // Import basic assemblies let tcGlobals, frameworkTcImports = - use frameworkImportsActivity = - Activity.instance.StartNoTags("import_framework_references") - TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) |> NodeCode.RunImmediateWithoutCancellation @@ -617,13 +609,10 @@ let main1 // Parse sourceFiles ReportTime tcConfig "Parse inputs" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - - let createDiagnosticsLogger = - (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) + use unwindParsePhase = UseBuildPhase BuildPhase.Parse let inputs = - ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, createDiagnosticsLogger, false) + ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, false) let inputs, _ = (Map.empty, inputs) @@ -656,9 +645,6 @@ let main1 ReportTime tcConfig "Import non-system references" let tcImports = - use nonFrameworkImportsActivity = - Activity.instance.StartNoTags("import_non_framework_references") - TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) |> NodeCode.RunImmediateWithoutCancellation @@ -674,29 +660,16 @@ let main1 // Build the initial type checking environment ReportTime tcConfig "Typecheck" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use unwindParsePhase = UseBuildPhase BuildPhase.TypeCheck let tcEnv0, openDecls0 = - use initialTcEnvActivity = Activity.instance.StartNoTags("get_initial_tc_env") GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) // Type check the inputs let inputs = inputs |> List.map fst let tcState, topAttrs, typedAssembly, _tcEnvAtEnd = - TypeCheck( - ctok, - tcConfig, - tcImports, - tcGlobals, - diagnosticsLogger, - assemblyName, - NiceNameGenerator(), - tcEnv0, - openDecls0, - inputs, - exiter - ) + TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter) AbortOnError(diagnosticsLogger, exiter) ReportTime tcConfig "Typechecked" @@ -718,194 +691,6 @@ let main1 ilSourceDocs ) -/// Alternative first phase of compilation. This is for the compile-from-AST feature of FCS. -/// - Import assemblies -/// - Check the inputs -let main1OfAst - ( - ctok, - legacyReferenceResolver, - reduceMemoryUsage, - assemblyName, - target, - outfile, - pdbFile, - dllReferences, - noframework, - exiter: Exiter, - diagnosticsLoggerProvider: DiagnosticsLoggerProvider, - disposables: DisposablesTracker, - inputs: ParsedInput list - ) = - - use main1AstActivity = Activity.instance.StartNoTags("main1_of_ast") - - let tryGetMetadataSnapshot = (fun _ -> None) - - let directoryBuildingFrom = Directory.GetCurrentDirectory() - - let defaultFSharpBinariesDir = - FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(None).Value - - let tcConfigB = - TcConfigBuilder.CreateNew( - legacyReferenceResolver, - defaultFSharpBinariesDir, - reduceMemoryUsage = reduceMemoryUsage, - implicitIncludeDir = directoryBuildingFrom, - isInteractive = false, - isInvalidationSupported = false, - defaultCopyFSharpCore = CopyFSharpCoreFlag.No, - tryGetMetadataSnapshot = tryGetMetadataSnapshot, - sdkDirOverride = None, - rangeForErrors = range0 - ) - - let primaryAssembly = - // temporary workaround until https://github.com/dotnet/fsharp/pull/8043 is merged: - // pick a primary assembly based on whether the developer included System>Runtime in the list of reference assemblies. - // It's an ugly compromise used to avoid exposing primaryAssembly in the public api for this function. - let includesSystem_Runtime = - dllReferences - |> Seq.exists (fun f -> - Path - .GetFileName(f) - .Equals("system.runtime.dll", StringComparison.InvariantCultureIgnoreCase)) - - if includesSystem_Runtime then - PrimaryAssembly.System_Runtime - else - PrimaryAssembly.Mscorlib - - tcConfigB.target <- target - tcConfigB.SetPrimaryAssembly primaryAssembly - - if noframework then - tcConfigB.implicitlyReferenceDotNetAssemblies <- false - tcConfigB.implicitlyResolveAssemblies <- false - - // Preset: --optimize+ -g --tailcalls+ (see 4505) - SetOptimizeSwitch tcConfigB OptionSwitch.On - - SetDebugSwitch - tcConfigB - None - (match pdbFile with - | Some _ -> OptionSwitch.On - | None -> OptionSwitch.Off) - - SetTailcallSwitch tcConfigB OptionSwitch.On - - // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = - diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter - - let _unwindEL_1 = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayForFlagsLogger) - - tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines - - // append assembly dependencies - dllReferences - |> List.iter (fun ref -> tcConfigB.AddReferencedAssemblyByPath(rangeStartup, ref)) - - // If there's a problem building TcConfig, abort - let tcConfig = - try - TcConfig.Create(tcConfigB, validate = false) - with e -> - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB - exiter.Exit 1 - - let dependencyProvider = new DependencyProvider() - - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) - - // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) - - // Forward all errors from flags - delayForFlagsLogger.CommitDelayedDiagnostics diagnosticsLogger - - // Resolve assemblies - ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" - let foundationalTcConfigP = TcConfigProvider.Constant tcConfig - - let sysRes, otherRes, knownUnresolved = - TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) - - // Import basic assemblies - let tcGlobals, frameworkTcImports = - TcImports.BuildFrameworkTcImports(foundationalTcConfigP, sysRes, otherRes) - |> NodeCode.RunImmediateWithoutCancellation - - // Register framework tcImports to be disposed in future - disposables.Register frameworkTcImports - - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - - let meta = Directory.GetCurrentDirectory() - - let tcConfig = - (tcConfig, inputs) - ||> List.fold (fun tcc inp -> ApplyMetaCommandsFromInputToTcConfig(tcc, inp, meta, dependencyProvider)) - - let tcConfigP = TcConfigProvider.Constant tcConfig - - // Import other assemblies - ReportTime tcConfig "Import non-system references" - - let tcImports = - TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, otherRes, knownUnresolved, dependencyProvider) - |> NodeCode.RunImmediateWithoutCancellation - - // register tcImports to be disposed in future - disposables.Register tcImports - - // Build the initial type checking environment - ReportTime tcConfig "Typecheck" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck - - let tcEnv0, openDecls0 = - GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - - // Type check the inputs - let tcState, topAttrs, typedAssembly, _tcEnvAtEnd = - TypeCheck( - ctok, - tcConfig, - tcImports, - tcGlobals, - diagnosticsLogger, - assemblyName, - NiceNameGenerator(), - tcEnv0, - openDecls0, - inputs, - exiter - ) - - AbortOnError(diagnosticsLogger, exiter) - ReportTime tcConfig "Typechecked" - - Args( - ctok, - tcGlobals, - tcImports, - frameworkTcImports, - tcState.Ccu, - typedAssembly, - topAttrs, - tcConfig, - outfile, - pdbFile, - assemblyName, - diagnosticsLogger, - exiter, - [] - ) - /// Second phase of compilation. /// - Write the signature file, check some attributes let main2 @@ -924,14 +709,12 @@ let main2 exiter: Exiter, ilSourceDocs)) = - use main2Activity = Activity.instance.StartNoTags("main2") - if tcConfig.typeCheckOnly then exiter.Exit 0 generatedCcu.Contents.SetAttribs(generatedCcu.Contents.Attribs @ topAttrs.assemblyAttrs) - use unwindPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.CodeGen + use unwindPhase = UseBuildPhase BuildPhase.CodeGen let signingInfo = ValidateKeySigningAttributes(tcConfig, tcGlobals, topAttrs) AbortOnError(diagnosticsLogger, exiter) @@ -949,7 +732,7 @@ let main2 GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) - let _unwindEL_3 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + let _holder = UseDiagnosticsLogger diagnosticsLogger // Try to find an AssemblyVersion attribute let assemVerFromAttrib = @@ -974,7 +757,7 @@ let main2 // write interface, xmldoc ReportTime tcConfig "Write Interface File" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output if tcConfig.printSignature || tcConfig.printAllSignatureFiles then InterfaceFileWriter.WriteInterfaceFile(tcGlobals, tcConfig, InfoReader(tcGlobals, tcImports.GetImportMap()), typedImplFiles) @@ -1033,7 +816,6 @@ let main3 exiter: Exiter, ilSourceDocs)) = - use main3Activity = Activity.instance.StartNoTags("main3") // Encode the signature data ReportTime tcConfig "Encode Interface Data" let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents @@ -1055,7 +837,7 @@ let main3 let optimizedImpls, optDataResources = // Perform optimization - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Optimize + use _ = UseBuildPhase BuildPhase.Optimize let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) @@ -1129,8 +911,6 @@ let main4 exiter: Exiter, ilSourceDocs)) = - use main4Activity = Activity.instance.StartNoTags("main4") - match tcImportsCapture with | None -> () | Some f -> f tcImports @@ -1144,7 +924,7 @@ let main4 let staticLinker = StaticLink(ctok, tcConfig, tcImports, ilGlobals) ReportTime tcConfig "TAST -> IL" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.IlxGen + use _ = UseBuildPhase BuildPhase.IlxGen // Create the Abstract IL generator let ilxGenerator = @@ -1233,9 +1013,8 @@ let main5 exiter: Exiter, ilSourceDocs)) = - use main5Activity = Activity.instance.StartNoTags("main5") - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output // Static linking, if any let ilxMainModule = @@ -1266,11 +1045,9 @@ let main6 exiter: Exiter, ilSourceDocs)) = - use main6Activity = Activity.instance.StartNoTags("main6") - ReportTime tcConfig "Write .NET Binary" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output let outfile = tcConfig.MakePathAbsolute outfile DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok @@ -1420,45 +1197,3 @@ let CompileFromCommandLineArguments |> main4 (tcImportsCapture, dynamicAssemblyCreator) |> main5 |> main6 dynamicAssemblyCreator - -/// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -let CompileFromSyntaxTrees - ( - ctok, - legacyReferenceResolver, - reduceMemoryUsage, - assemblyName, - target, - targetDll, - targetPdb, - dependencies, - noframework, - exiter, - loggerProvider, - inputs, - tcImportsCapture, - dynamicAssemblyCreator - ) = - - use disposables = new DisposablesTracker() - - main1OfAst ( - ctok, - legacyReferenceResolver, - reduceMemoryUsage, - assemblyName, - target, - targetDll, - targetPdb, - dependencies, - noframework, - exiter, - loggerProvider, - disposables, - inputs - ) - |> main2 - |> main3 - |> main4 (tcImportsCapture, dynamicAssemblyCreator) - |> main5 - |> main6 dynamicAssemblyCreator diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 12ed13273da..8731b5fae0c 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -13,18 +13,18 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals -[] -type DiagnosticsLoggerProvider = - new: unit -> DiagnosticsLoggerProvider - abstract CreateDiagnosticsLoggerUpToMaxErrors: - tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger +/// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking +/// of the flags themselves we have to create temporary loggers, until the full configuration is +/// available. +type IDiagnosticsLoggerProvider = + abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger /// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - inherit DiagnosticsLoggerProvider + interface IDiagnosticsLoggerProvider -/// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached +/// An diagnostic logger that reports errors up to some maximum, notifying the exiter when that maximum is reached /// /// Used only in LegacyHostedCompilerForTesting [] @@ -33,8 +33,7 @@ type DiagnosticsLoggerUpToMaxErrors = new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors /// Called when a diagnostic occurs - abstract HandleIssue: - tcConfigB: TcConfigBuilder * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + abstract HandleIssue: tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit @@ -52,25 +51,10 @@ val CompileFromCommandLineArguments: reduceMemoryUsage: ReduceMemoryFlag * defaultCopyFSharpCore: CopyFSharpCoreFlag * exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * + loggerProvider: IDiagnosticsLoggerProvider * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit -/// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -val CompileFromSyntaxTrees: - ctok: CompilationThreadToken * - legacyReferenceResolver: LegacyReferenceResolver * - reduceMemoryUsage: ReduceMemoryFlag * - assemblyName: string * - target: CompilerTarget * - targetDll: string * - targetPdb: string option * - dependencies: string list * - noframework: bool * - exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * - inputs: ParsedInput list * - tcImportsCapture: (TcImports -> unit) option * - dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> - unit +/// Read the parallelReferenceResolution flag from environment variables +val internal getParallelReferenceResolutionFromEnvironment: unit -> ParallelReferenceResolution option diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 64f0876b61d..a298af54908 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -55,7 +55,6 @@ tupleRequiredInAbstractMethod,"\nA tuple type is required for one or more argume 226,buildInvalidSourceFileExtensionUpdated,"The file extension of '%s' is not recognized. Source files must have extension .fs, .fsi, .fsx or .fsscript" 226,buildInvalidSourceFileExtensionML,"The file extension of '%s' is not recognized. Source files must have extension .fs, .fsi, .fsx or .fsscript. To enable the deprecated use of .ml or .mli extensions, use '--langversion:5.0' and '--mlcompatibility'." 227,buildCouldNotResolveAssembly,"Could not resolve assembly '%s'" -228,buildCouldNotResolveAssemblyRequiredByFile,"Could not resolve assembly '%s' required by '%s'" 229,buildErrorOpeningBinaryFile,"Error opening binary file '%s': %s" 231,buildDifferentVersionMustRecompile,"The F#-compiled DLL '%s' needs to be recompiled to be used with this version of F#" 232,buildInvalidHashIDirective,"Invalid directive. Expected '#I \"\"'." @@ -252,7 +251,7 @@ chkVariableUsedInInvalidWay,"The variable '%s' is used in an invalid way" 417,chkNoFirstClassRethrow,"First-class uses of the 'reraise' function is not permitted" 418,chkNoByrefAtThisPoint,"The byref typed value '%s' cannot be used at this point" 419,chkLimitationsOfBaseKeyword,"'base' values may only be used to make direct calls to the base implementations of overridden members" -420,chkObjCtorsCantUseExceptionHandling,"Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL." +#420,chkObjCtorsCantUseExceptionHandling,"Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL." 421,chkNoAddressOfAtThisPoint,"The address of the variable '%s' cannot be used at this point" 422,chkNoAddressStaticFieldAtThisPoint,"The address of the static field '%s' cannot be used at this point" 423,chkNoAddressFieldAtThisPoint,"The address of the field '%s' cannot be used at this point" @@ -572,7 +571,7 @@ tcCouldNotFindIDisposable,"Couldn't find Dispose on IDisposable, or it was overl 724,tcInvalidIndexIntoActivePatternArray,"Internal error. Invalid index into active pattern array" 725,tcUnionCaseDoesNotTakeArguments,"This union case does not take arguments" 726,tcUnionCaseRequiresOneArgument,"This union case takes one argument" -727,tcUnionCaseExpectsTupledArguments,"This union case expects %d arguments in tupled form" +727,tcUnionCaseExpectsTupledArguments,"This union case expects %d arguments in tupled form, but was given %d. The missing field arguments may be any of:%s" 728,tcFieldIsNotStatic,"Field '%s' is not static" 729,tcFieldNotLiteralCannotBeUsedInPattern,"This field is not a literal and cannot be used in a pattern" 730,tcRequireVarConstRecogOrLiteral,"This is not a variable, constant, active recognizer or literal" @@ -1653,3 +1652,5 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"'%s' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." 3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." 3545,tcMissingRequiredMembers,"The following required properties have to be initalized:%s" +3546,parsExpectingPatternInTuple,"Expecting pattern" +3547,parsExpectedPatternAfterToken,"Expected a pattern after this point" diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index b23c73f8018..c3d3bb0f672 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -13,7 +13,7 @@ FSharp.Compiler.Service true $(DefineConstants);COMPILER - $(DefineConstants);USE_SHIPPED_FSCORE + $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1 $(OtherFlags) --warnon:1182 diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index e32a14ae886..b8ee50564c1 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -7,7 +7,6 @@ open System.Threading open System.Threading.Tasks open System.Diagnostics open System.Globalization -open FSharp.Compiler.Diagnostics.Activity open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library @@ -108,13 +107,11 @@ type NodeCodeBuilder() = ) [] - member _.Using(value: ActivityFacade, binder: ActivityFacade -> NodeCode<'U>) = + member _.Using(value: IDisposable, binder: IDisposable -> NodeCode<'U>) = Node( async { - try - return! binder value |> Async.AwaitNodeCode - finally - (value :> IDisposable).Dispose() + use _ = value + return! binder value |> Async.AwaitNodeCode } ) @@ -195,6 +192,12 @@ type NodeCode private () = return results.ToArray() } + + static member Parallel (computations: NodeCode<'T> seq) = + computations + |> Seq.map (fun (Node x) -> x) + |> Async.Parallel + |> Node type private AgentMessage<'T> = GetValue of AsyncReplyChannel> * callerCancellationToken: CancellationToken @@ -344,7 +347,7 @@ type GraphNode<'T>(retryCompute: bool, computation: NodeCode<'T>) = // occur, making sure we are under the protection of the 'try'. // For example, NodeCode's 'try/finally' (TryFinally) uses async.TryFinally which does // implicit cancellation checks even before the try is entered, as do the - // de-sugaring of 'do!' and other CodeCode constructs. + // de-sugaring of 'do!' and other NodeCode constructs. let mutable taken = false try diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 2620c2eb296..9110df4dfae 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -6,7 +6,6 @@ open System open System.Diagnostics open System.Threading open System.Threading.Tasks -open FSharp.Compiler.Diagnostics.Activity open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library @@ -49,7 +48,7 @@ type NodeCodeBuilder = /// that a proper generic 'use' could be implemented but has not currently been necessary) member Using: CompilationGlobalsScope * (CompilationGlobalsScope -> NodeCode<'T>) -> NodeCode<'T> - member Using: ActivityFacade * (ActivityFacade -> NodeCode<'T>) -> NodeCode<'T> + member Using: IDisposable * (IDisposable -> NodeCode<'T>) -> NodeCode<'T> /// Specifies code that can be run as part of the build graph. val node: NodeCodeBuilder @@ -69,6 +68,8 @@ type NodeCode = static member Sequential: computations: NodeCode<'T> seq -> NodeCode<'T[]> + static member Parallel: computations: (NodeCode<'T> seq) -> NodeCode<'T[]> + /// Execute the cancellable computation synchronously using the ambient cancellation token of /// the NodeCode. static member FromCancellable: computation: Cancellable<'T> -> NodeCode<'T> diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 4c82c5f445a..8bf00bef80f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -159,7 +159,7 @@ let rec AttachRange m (exn: exn) = | UnresolvedPathReferenceNoRange (a, p) -> UnresolvedPathReference(a, p, m) | Failure msg -> InternalError(msg + " (Failure)", m) | :? ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) - | notARangeDual -> notARangeDual + | _ -> exn type Exiter = abstract Exit: int -> 'T @@ -172,9 +172,18 @@ let QuitProcessExiter = with _ -> () - FSComp.SR.elSysEnvExitDidntExit () |> failwith + failwith (FSComp.SR.elSysEnvExitDidntExit ()) } +type StopProcessingExiter() = + + member val ExitCode = 0 with get, set + + interface Exiter with + member exiter.Exit n = + exiter.ExitCode <- n + raise StopProcessing + /// Closed enumeration of build phases. [] type BuildPhase = @@ -304,6 +313,8 @@ type DiagnosticsLogger(nameForDebugging: string) = // code just below and get a breakpoint for all error logger implementations. abstract DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + member x.CheckForErrors() = (x.ErrorCount > 0) + member _.DebugDisplay() = sprintf "DiagnosticsLogger(%s)" nameForDebugging @@ -320,12 +331,17 @@ let AssertFalseDiagnosticsLogger = member _.ErrorCount = (* assert false; *) 0 } -type CapturingDiagnosticsLogger(nm) = +type CapturingDiagnosticsLogger(nm, ?eagerFormat) = inherit DiagnosticsLogger(nm) let mutable errorCount = 0 let diagnostics = ResizeArray() override _.DiagnosticSink(diagnostic, severity) = + let diagnostic = + match eagerFormat with + | None -> diagnostic + | Some f -> f diagnostic + if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 @@ -476,7 +492,7 @@ module DiagnosticsLoggerExtensions = member x.ErrorRecoveryNoRange(exn: exn) = x.ErrorRecovery exn range0 /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushThreadBuildPhaseUntilUnwind (phase: BuildPhase) = +let UseBuildPhase (phase: BuildPhase) = let oldBuildPhase = DiagnosticsThreadStatics.BuildPhaseUnchecked DiagnosticsThreadStatics.BuildPhase <- phase @@ -486,15 +502,18 @@ let PushThreadBuildPhaseUntilUnwind (phase: BuildPhase) = } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushDiagnosticsLoggerPhaseUntilUnwind (diagnosticsLoggerTransformer: DiagnosticsLogger -> #DiagnosticsLogger) = - let oldDiagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLoggerTransformer oldDiagnosticsLogger +let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) = + let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger { new IDisposable with member _.Dispose() = - DiagnosticsThreadStatics.DiagnosticsLogger <- oldDiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger } +let UseDiagnosticsLogger newLogger = + UseTransformedDiagnosticsLogger (fun _ -> newLogger) + let SetThreadBuildPhaseNoUnwind (phase: BuildPhase) = DiagnosticsThreadStatics.BuildPhase <- phase @@ -505,8 +524,8 @@ let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger = /// /// Use to reset error and warning handlers. type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: BuildPhase) = - let unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) - let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase + let unwindEL = UseDiagnosticsLogger diagnosticsLogger + let unwindBP = UseBuildPhase buildPhase member _.DiagnosticsLogger = diagnosticsLogger member _.BuildPhase = buildPhase diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index c3af3a7da9d..0ac4c90583e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -85,11 +85,21 @@ val inline protectAssemblyExplorationNoReraise: dflt1: 'T -> dflt2: 'T -> f: (un val AttachRange: m: range -> exn: exn -> exn +/// Represnts an early exit from parsing, checking etc, for example because 'maxerrors' has been reached. type Exiter = - abstract member Exit: int -> 'T + abstract Exit: int -> 'T +/// An exiter that quits the process if Exit is called. val QuitProcessExiter: Exiter +/// An exiter that raises StopProcessingException if Exit is called, saving the exit code in ExitCode. +type StopProcessingExiter = + interface Exiter + + new: unit -> StopProcessingExiter + + member ExitCode: int with get, set + /// Closed enumeration of build phases. [] type BuildPhase = @@ -166,6 +176,7 @@ type PhasedDiagnostic = /// member Subcategory: unit -> string +/// Represents a capability to log diagnostics [] type DiagnosticsLogger = @@ -173,18 +184,27 @@ type DiagnosticsLogger = member DebugDisplay: unit -> string - abstract member DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + /// Emit a diagnostic to the logger + abstract DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - abstract member ErrorCount: int + /// Get the number of error diagnostics reported + abstract ErrorCount: int + /// Checks if ErrorCount > 0 + member CheckForErrors: unit -> bool + +/// Represents a DiagnosticsLogger that discards diagnostics val DiscardErrorsLogger: DiagnosticsLogger +/// Represents a DiagnosticsLogger that ignores diagnostics and asserts val AssertFalseDiagnosticsLogger: DiagnosticsLogger +/// Represents a DiagnosticsLogger that captures all diagnostics, optionally formatting them +/// eagerly. type CapturingDiagnosticsLogger = inherit DiagnosticsLogger - new: nm: string -> CapturingDiagnosticsLogger + new: nm: string * ?eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic) -> CapturingDiagnosticsLogger member CommitDelayedDiagnostics: diagnosticsLogger: DiagnosticsLogger -> unit @@ -194,6 +214,7 @@ type CapturingDiagnosticsLogger = override ErrorCount: int +/// Thread statics for the installed diagnostic logger [] type DiagnosticsThreadStatics = @@ -216,26 +237,41 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with + /// Report a diagnostic as an error and recover member ErrorR: exn: exn -> unit + /// Report a diagnostic as a warning and recover member Warning: exn: exn -> unit + /// Report a diagnostic as an error and raise `ReportedError` member Error: exn: exn -> 'T + /// Simulates a diagnostic. For test purposes only. member SimulateError: diagnostic: PhasedDiagnostic -> 'T + /// Perform error recovery from an exception if possible. + /// - StopProcessingExn is not caught. + /// - ReportedError is caught and ignored. + /// - TargetInvocationException is unwrapped + /// - If precisely a System.Exception or ArgumentException then the range is attached as InternalError. + /// - Other exceptions are unchanged + /// + /// All are reported via the installed diagnostics logger member ErrorRecovery: exn: exn -> m: range -> unit + /// Perform error recovery from an exception if possible, including catching StopProcessingExn member StopProcessingRecovery: exn: exn -> m: range -> unit + /// Like ErrorRecover by no range is attached to System.Exception and ArgumentException. member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable +val UseBuildPhase: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushDiagnosticsLoggerPhaseUntilUnwind: - diagnosticsLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable +val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable + +val UseDiagnosticsLogger: newLogger: DiagnosticsLogger -> IDisposable val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit diff --git a/src/Compiler/Facilities/Logger.fs b/src/Compiler/Facilities/Logger.fs index 76fd3f2d897..9852cab6d7d 100644 --- a/src/Compiler/Facilities/Logger.fs +++ b/src/Compiler/Facilities/Logger.fs @@ -6,113 +6,15 @@ open System open System.Diagnostics open System.Diagnostics.Tracing -module Activity = - - type ActivityFacade(activity : Activity option) = - member this.AddTag key (value : #obj) = match activity with | Some activity -> activity.AddTag(key, value) |> ignore | None -> () - member this.Perform action = match activity with | Some activity -> action activity | None -> () - member this.Dispose() = match activity with | Some activity -> activity.Dispose() | None -> () - interface IDisposable with - member this.Dispose() = this.Dispose() - - let start (source : ActivitySource) (activityName : string) (tags : (string * #obj) seq) = - let activity = source.StartActivity(activityName) |> Option.ofObj - let facade = new ActivityFacade(activity) - for key, value in tags do - facade.AddTag key value - facade - - let startNoTags (source : ActivitySource) (activityName : string) = start source activityName [] - - type ActivitySourceFacade(source : ActivitySource) = - member this.Start (name : string) (tags : (string * #obj) seq) = start source name tags - member this.StartNoTags name = startNoTags source name - member this.Name = source.Name - member this.Dispose() = source.Dispose() - interface IDisposable with - member this.Dispose() = this.Dispose() - - let private activitySourceName = "fsc" - let private activitySource = new ActivitySource(activitySourceName) - let instance = new ActivitySourceFacade(activitySource) - -type LogCompilerFunctionId = - | Service_ParseAndCheckFileInProject = 1 - | Service_CheckOneFile = 2 - | Service_IncrementalBuildersCache_BuildingNewCache = 3 - | Service_IncrementalBuildersCache_GettingCache = 4 - | CompileOps_TypeCheckOneInputAndFinishEventually = 5 - | IncrementalBuild_CreateItemKeyStoreAndSemanticClassification = 6 - | IncrementalBuild_TypeCheck = 7 - -/// This is for ETW tracing across FSharp.Compiler. -[] -type FSharpCompilerEventSource() = - inherit EventSource() - - static let instance = new FSharpCompilerEventSource() - static member Instance = instance - - [] - member this.Log(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(1, int functionId) - - [] - member this.LogMessage(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(2, message, int functionId) - - [] - member this.BlockStart(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(3, int functionId) - - [] - member this.BlockStop(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(4, int functionId) - - [] - member this.BlockMessageStart(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(5, message, int functionId) - - [] - member this.BlockMessageStop(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(6, message, int functionId) - [] -module Logger = - - let Log functionId = - FSharpCompilerEventSource.Instance.Log(functionId) - - let LogMessage message functionId = - FSharpCompilerEventSource.Instance.LogMessage(message, functionId) - - let LogBlockStart functionId = - FSharpCompilerEventSource.Instance.BlockStart(functionId) - - let LogBlockStop functionId = - FSharpCompilerEventSource.Instance.BlockStop(functionId) - - let LogBlockMessageStart message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStart(message, functionId) - - let LogBlockMessageStop message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStop(message, functionId) - - let LogBlock functionId = - FSharpCompilerEventSource.Instance.BlockStart(functionId) +module Activity = - { new IDisposable with - member _.Dispose() = - FSharpCompilerEventSource.Instance.BlockStop(functionId) - } + let private activitySource = new ActivitySource("fsc") - let LogBlockMessage message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStart(message, functionId) + let Start name (tags:(string * #obj) seq) : IDisposable = + let act = activitySource.StartActivity(name) + for key,value in tags do + act.AddTag(key,value) |> ignore + act - { new IDisposable with - member _.Dispose() = - FSharpCompilerEventSource.Instance.BlockMessageStop(message, functionId) - } + let StartNoTags name: IDisposable = activitySource.StartActivity(name) \ No newline at end of file diff --git a/src/Compiler/Facilities/Logger.fsi b/src/Compiler/Facilities/Logger.fsi index 73e8f443fe5..4eba109adf7 100644 --- a/src/Compiler/Facilities/Logger.fsi +++ b/src/Compiler/Facilities/Logger.fsi @@ -5,49 +5,11 @@ namespace FSharp.Compiler.Diagnostics open System open System.Diagnostics -module internal Activity = - - type ActivityFacade = - interface IDisposable - new: Activity option -> ActivityFacade - member AddTag: string -> #obj -> unit - member Perform: (Activity -> unit) -> unit - member Dispose: unit -> unit - - type ActivitySourceFacade = - interface IDisposable - new: ActivitySource -> ActivitySourceFacade - member Start: string -> (string * #obj) seq -> ActivityFacade - member StartNoTags: string -> ActivityFacade - member Name: string - member Dispose: unit -> unit - - val instance: ActivitySourceFacade - -type internal LogCompilerFunctionId = - | Service_ParseAndCheckFileInProject = 1 - | Service_CheckOneFile = 2 - | Service_IncrementalBuildersCache_BuildingNewCache = 3 - | Service_IncrementalBuildersCache_GettingCache = 4 - | CompileOps_TypeCheckOneInputAndFinishEventually = 5 - | IncrementalBuild_CreateItemKeyStoreAndSemanticClassification = 6 - | IncrementalBuild_TypeCheck = 7 - +/// For activities following the dotnet distributed tracing concept +/// https://learn.microsoft.com/en-us/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations [] -module internal Logger = - - val Log: LogCompilerFunctionId -> unit - - val LogMessage: message: string -> LogCompilerFunctionId -> unit - - val LogBlockStart: LogCompilerFunctionId -> unit - - val LogBlockStop: LogCompilerFunctionId -> unit - - val LogBlockMessageStart: message: string -> LogCompilerFunctionId -> unit - - val LogBlockMessageStop: message: string -> LogCompilerFunctionId -> unit +module internal Activity = - val LogBlock: LogCompilerFunctionId -> IDisposable + val StartNoTags: name: string -> IDisposable - val LogBlockMessage: message: string -> LogCompilerFunctionId -> IDisposable + val Start: name: string -> tags: (string * #obj) seq -> IDisposable diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 316dfd429bb..f4ee6685a11 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -726,13 +726,12 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = if 0 < i && i <= lines.Length then lines[i-1] else "" /// Display the given error. - member syphon.PrintError (tcConfig:TcConfigBuilder, err) = + member syphon.PrintDiagnostic (tcConfig:TcConfig, diagnostic: PhasedDiagnostic) = ignoreAllErrors (fun () -> let severity = FSharpDiagnosticSeverity.Error DoWithDiagnosticColor severity (fun () -> errorWriter.WriteLine() - writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err - writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(errorWriter, " ", syphon.GetLine, tcConfig, severity) errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -773,34 +772,33 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, member _.ResetErrorCount() = errorCount <- 0 - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then - fsiStdinSyphon.PrintError(tcConfigB,err) + override _.DiagnosticSink(diagnostic, severity) = + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + if diagnostic.ReportAsError (tcConfig.diagnosticsOptions, severity) then + fsiStdinSyphon.PrintDiagnostic(tcConfig,diagnostic) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then + elif diagnostic.ReportAsWarning (tcConfig.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(fsiConsoleOutput.Error, " ", fsiStdinSyphon.GetLine, tcConfig, severity) fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then + elif diagnostic.ReportAsInfo (tcConfig.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(fsiConsoleOutput.Error, " ", fsiStdinSyphon.GetLine, tcConfig, severity) fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - override x.ErrorCount = errorCount + override _.ErrorCount = errorCount type DiagnosticsLogger with - member x.CheckForErrors() = (x.ErrorCount > 0) + /// A helper function to check if its time to abort member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = if x.ErrorCount > 0 then @@ -827,8 +825,7 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, tcConfigB, fsiConsoleOutput: FsiConsoleOutput) = - let mutable enableConsoleKeyProcessing = - not (Environment.OSVersion.Platform = PlatformID.Win32NT) + let mutable enableConsoleKeyProcessing = true let mutable gui = true // override via "--gui" on by default #if DEBUG @@ -1202,7 +1199,7 @@ type internal FsiConsoleInput(fsi: FsiEvaluationSessionHostConfig, fsiOptions: F type FsiInteractionStepStatus = | CtrlC | EndOfFile - | Completed of option + | Completed of FsiValue option | CompletedWithAlreadyReportedError | CompletedWithReportedError of exn @@ -1331,7 +1328,6 @@ type internal FsiDynamicCompiler( fsiOptions : FsiCommandLineOptions, fsiConsoleOutput : FsiConsoleOutput, fsiCollectible: bool, - niceNameGen, resolveAssemblyRef ) = @@ -1353,7 +1349,9 @@ type internal FsiDynamicCompiler( let dynamicAssemblies = ResizeArray() - let mutable needsPackageResolution = false + let mutable hasDelayedDependencyManagerText = false + + let mutable delayedReferences = ResizeArray<_>() let generateDebugInfo = tcConfigB.debuginfo @@ -1373,6 +1371,8 @@ type internal FsiDynamicCompiler( let infoReader = InfoReader(tcGlobals,tcImports.GetImportMap()) + let reportedAssemblies = Dictionary() + /// Add attributes let CreateModuleFragment (tcConfigB: TcConfigBuilder, dynamicCcuName, codegenResults) = if progress then fprintfn fsiConsoleOutput.Out "Creating main module..." @@ -1673,10 +1673,24 @@ type internal FsiDynamicCompiler( let ilxGenerator = istate.ilxGenerator let tcConfig = TcConfig.Create(tcConfigB,validate=false) + let eagerFormat (diag: PhasedDiagnostic) = + diag.EagerlyFormatCore true + // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) let tcState, topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput = - lock tcLockObject (fun _ -> CheckClosedInputSet(ctok, diagnosticsLogger.CheckForErrors, tcConfig, tcImports, tcGlobals, Some prefixPath, tcState, inputs)) + lock tcLockObject (fun _ -> + CheckClosedInputSet( + ctok, + diagnosticsLogger.CheckForErrors, + tcConfig, + tcImports, + tcGlobals, + Some prefixPath, + tcState, + eagerFormat, + inputs) + ) let codegenResults, optEnv, fragName = ProcessTypedImpl(diagnosticsLogger, optEnv, tcState, tcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator) @@ -1869,9 +1883,13 @@ type internal FsiDynamicCompiler( // let optValue = istate.ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext(istate.emEnv), vref.Deref) - match optValue with - | Some (res, ty) -> istate, Completed(Some(FsiValue(res, ty, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, vref.Type)))) - | _ -> istate, Completed None + + let fsiValue = + match optValue with + | Some (res, ty) -> Some(FsiValue(res, ty, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, vref.Type))) + | _ -> None + + istate, Completed fsiValue // Return the interactive state. | _ -> istate, Completed None @@ -1895,30 +1913,90 @@ type internal FsiDynamicCompiler( let breakStatement = SynExpr.App (ExprAtomicFlag.Atomic, false, methCall, args, m) SynModuleDecl.Expr(breakStatement, m) - member _.EvalRequireReference (ctok, istate, m, path) = + /// Resolve and register an assembly reference, delaying the actual addition of the reference + /// to tcImports until a whole set of references has been collected. + /// + /// That is, references are collected across a group of #r declarations and only added to the + /// tcImports state once all are collected. + member _.AddDelayedReference (ctok, path, show, m) = + + // Check the file can be resolved if FileSystem.IsInvalidPathShim(path) then - error(Error(FSIstrings.SR.fsiInvalidAssembly(path),m)) - // Check the file can be resolved before calling requireDLLReference - let resolutions = tcImports.ResolveAssemblyReference(ctok, AssemblyReference(m,path,None), ResolveAssemblyReferenceMode.ReportErrors) - tcConfigB.AddReferencedAssemblyByPath(m,path) + error(Error(FSIstrings.SR.fsiInvalidAssembly(path), m)) + + // Do the resolution + let resolutions = + tcImports.ResolveAssemblyReference(ctok, AssemblyReference(m,path,None), ResolveAssemblyReferenceMode.ReportErrors) + + // Delay the addition of the assembly to the interactive state + delayedReferences.Add((path, resolutions, show, m)) + + /// Indicates if there are delayed assembly additions to be processed. + member _.HasDelayedReferences = delayedReferences.Count > 0 + + /// Process any delayed assembly additions. + member _.ProcessDelayedReferences (ctok, istate) = + + // Grab the dealyed assembly reference additions + let refs = delayedReferences |> Seq.toList + delayedReferences.Clear() + + // Print the explicit assembly resolutions. Only for explicit '#r' in direct inputs, not those + // in #load files. This means those resulting from nuget package resolution are not shown. + for (_, resolutions, show, _) in refs do + if show then + for ar in resolutions do + let format = + if tcConfigB.shadowCopyReferences then + let resolvedPath = ar.resolvedPath.ToUpperInvariant() + let fileTime = FileSystem.GetLastWriteTimeShim(resolvedPath) + match reportedAssemblies.TryGetValue resolvedPath with + | false, _ -> + reportedAssemblies.Add(resolvedPath, fileTime) + FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) + | true, time when time <> fileTime -> + FSIstrings.SR.fsiDidAHashrWithStaleWarning(ar.resolvedPath) + | _ -> + FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) + else + FSIstrings.SR.fsiDidAHashrWithLockWarning(ar.resolvedPath) + + fsiConsoleOutput.uprintnfnn "%s" format + + // Collect the overall resolutions + let resolutions = + [ for (_, resolutions, _, _) in refs do + yield! resolutions ] + + // Add then to the config. + for (path, _, _, m) in refs do + tcConfigB.AddReferencedAssemblyByPath(m, path) + let tcState = istate.tcState - let tcEnv,(_dllinfos,ccuinfos) = + + let tcEnv, asms = try - RequireDLL (ctok, tcImports, tcState.TcEnvFromImpls, dynamicCcuName, m, path) + RequireReferences (ctok, tcImports, tcState.TcEnvFromImpls, dynamicCcuName, resolutions) with _ -> - tcConfigB.RemoveReferencedAssemblyByPath(m,path) + for (path, _, _, m) in refs do + tcConfigB.RemoveReferencedAssemblyByPath(m,path) reraise() - resolutions, - { addCcusToIncrementalEnv istate ccuinfos with tcState = tcState.NextStateAfterIncrementalFragment(tcEnv) } - member _.EvalDependencyManagerTextFragment (packageManager:IDependencyManagerProvider, lt, m, path: string) = + let istate = { addCcusToIncrementalEnv istate asms with tcState = tcState.NextStateAfterIncrementalFragment(tcEnv) } + + istate + // Dependency manager text is collected across a group of #r and #i declarations and + // only actually processed once all are collected. + member _.AddDelayedDependencyManagerText (packageManager:IDependencyManagerProvider, lt, m, path: string) = tcConfigB.packageManagerLines <- PackageManagerLine.AddLineWithKey packageManager.Key lt path m tcConfigB.packageManagerLines - needsPackageResolution <- true + hasDelayedDependencyManagerText <- true + + member _.HasDelayedDependencyManagerText = hasDelayedDependencyManagerText - member fsiDynamicCompiler.CommitDependencyManagerText (ctok, istate: FsiDynamicCompilerState, lexResourceManager, diagnosticsLogger) = - if not needsPackageResolution then istate else - needsPackageResolution <- false + member fsiDynamicCompiler.ProcessDelayedDependencyManagerText (ctok, istate: FsiDynamicCompilerState, lexResourceManager, diagnosticsLogger) = + if not hasDelayedDependencyManagerText then istate else + hasDelayedDependencyManagerText <- false (istate, tcConfigB.packageManagerLines) ||> Seq.fold (fun istate kv -> let (KeyValue(packageManagerKey, packageManagerLines)) = kv @@ -1980,38 +2058,47 @@ type internal FsiDynamicCompiler( reraise () ) - member fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands(ctok, istate, sourceFile, inp) = + member fsiDynamicCompiler.PartiallyProcessReferenceOrPackageIncudePathDirective (ctok, istate, directiveKind, path, show, m) = + let dm = fsiOptions.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) + match dm with + | Null, Null -> + // error already reported + istate, CompletedWithAlreadyReportedError + + | _, NonNull dependencyManager -> + if tcConfigB.langVersion.SupportsFeature(LanguageFeature.PackageManagement) then + fsiDynamicCompiler.AddDelayedDependencyManagerText(dependencyManager, directiveKind, m, path) + istate, Completed None + else + errorR(Error(FSComp.SR.packageManagementRequiresVFive(), m)) + istate, Completed None + + | _, _ when directiveKind = Directive.Include -> + errorR(Error(FSComp.SR.poundiNotSupportedByRegisteredDependencyManagers(), m)) + istate, Completed None + + | NonNull p, Null -> + let path = + if String.IsNullOrWhiteSpace(p) then "" + else p + + fsiDynamicCompiler.AddDelayedReference(ctok, path, show, m) + + istate, Completed None + + /// Scrape #r, #I and package manager commands from a #load + member fsiDynamicCompiler.ProcessMetaCommandsFromParsedInputAsInteractiveCommands(ctok, istate: FsiDynamicCompilerState, sourceFile, input) = WithImplicitHome (tcConfigB, directoryName sourceFile) (fun () -> ProcessMetaCommandsFromInput ((fun st (m,nm) -> tcConfigB.TurnWarningOff(m,nm); st), (fun st (m, path, directive) -> - - let dm = tcImports.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) - - match dm with - | _, NonNull dependencyManager -> - if tcConfigB.langVersion.SupportsFeature(LanguageFeature.PackageManagement) then - fsiDynamicCompiler.EvalDependencyManagerTextFragment (dependencyManager, directive, m, path) - st - else - errorR(Error(FSComp.SR.packageManagementRequiresVFive(), m)) - st - - | _, _ when directive = Directive.Include -> - errorR(Error(FSComp.SR.poundiNotSupportedByRegisteredDependencyManagers(), m)) - st - - // #r "Assembly" - | NonNull path, _ -> - snd (fsiDynamicCompiler.EvalRequireReference (ctok, st, m, path)) - - | Null, Null -> - st + let st, _ = fsiDynamicCompiler.PartiallyProcessReferenceOrPackageIncudePathDirective (ctok, st, directive, path, false, m) + st ), (fun _ _ -> ())) - (tcConfigB, inp, Path.GetDirectoryName sourceFile, istate)) + (tcConfigB, input, Path.GetDirectoryName sourceFile, istate)) member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, diagnosticsLogger: DiagnosticsLogger) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) @@ -2059,7 +2146,10 @@ type internal FsiDynamicCompiler( |> List.unzip diagnosticsLogger.AbortOnError(fsiConsoleOutput); - let istate = (istate, sourceFiles, inputs) |||> List.fold2 (fun istate sourceFile input -> fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands(ctok, istate, sourceFile, input)) + let istate = (istate, sourceFiles, inputs) |||> List.fold2 (fun istate sourceFile input -> fsiDynamicCompiler.ProcessMetaCommandsFromParsedInputAsInteractiveCommands(ctok, istate, sourceFile, input)) + + let istate = fsiDynamicCompiler.ProcessDelayedReferences (ctok, istate) + fsiDynamicCompiler.EvalParsedSourceFiles (ctok, diagnosticsLogger, istate, inputs, m) member _.GetBoundValues istate = @@ -2156,7 +2246,7 @@ type internal FsiDynamicCompiler( let tcEnv, openDecls0 = GetInitialTcEnv (dynamicCcuName, rangeStdin0, tcConfig, tcImports, tcGlobals) let ccuName = dynamicCcuName - let tcState = GetInitialTcState (rangeStdin0, ccuName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv, openDecls0) + let tcState = GetInitialTcState (rangeStdin0, ccuName, tcConfig, tcGlobals, tcImports, tcEnv, openDecls0) let ilxGenerator = CreateIlxAssemblyGenerator (tcConfig, tcImports, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), tcState.Ccu) @@ -2281,13 +2371,13 @@ type internal FsiInterruptController( exitViaKillThread <- false // don't exit via kill thread member _.PosixInvoke(n:int) = - // we run this code once with n = -1 to make sure it is JITted before execution begins - // since we are not allowed to JIT a signal handler. This also ensures the "PosixInvoke" - // method is not eliminated by dead-code elimination - if n >= 0 then - posixReinstate() - stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed - killThreadRequest <- if (interruptAllowed = InterruptCanRaiseException) then ThreadAbortRequest else PrintInterruptRequest + // we run this code once with n = -1 to make sure it is JITted before execution begins + // since we are not allowed to JIT a signal handler. This also ensures the "PosixInvoke" + // method is not eliminated by dead-code elimination + if n >= 0 then + posixReinstate() + stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed + killThreadRequest <- if (interruptAllowed = InterruptCanRaiseException) then ThreadAbortRequest else PrintInterruptRequest //---------------------------------------------------------------------------- // assembly finder @@ -2561,6 +2651,11 @@ type FsiStdinLexerProvider member _.CreateBufferLexer (sourceFileName, lexbuf, diagnosticsLogger) = CreateLexerForLexBuffer (sourceFileName, lexbuf, diagnosticsLogger) +[] +type InteractionGroup = + | Definitions of defns: SynModuleDecl list * range: range + + | HashDirectives of hashDirective: ParsedHashDirective list //---------------------------------------------------------------------------- // Process one parsed interaction. This runs on the GUI thread. @@ -2581,8 +2676,6 @@ type FsiInteractionProcessor initialInteractiveState ) = - let referencedAssemblies = Dictionary() - let mutable currState = initialInteractiveState let event = Control.Event() let setCurrState s = currState <- s; event.Trigger() @@ -2624,7 +2717,6 @@ type FsiInteractionProcessor else error(Error(FSIstrings.SR.fsiDirectoryDoesNotExist(path),m)) - /// Parse one interaction. Called on the parser thread. let ParseInteraction (tokenizer:LexFilter.LexFilter) = let mutable lastToken = Parser.ELSE // Any token besides SEMICOLON_SEMICOLON will do for initial value @@ -2652,217 +2744,239 @@ type FsiInteractionProcessor stopProcessingRecovery e range0 None - /// Execute a single parsed interaction. Called on the GUI/execute/main thread. - let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, diagnosticsLogger: DiagnosticsLogger) = - let packageManagerDirective directive path m = - let dm = fsiOptions.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) - match dm with - | Null, Null -> - // error already reported - istate, CompletedWithAlreadyReportedError - - | _, NonNull dependencyManager -> - if tcConfig.langVersion.SupportsFeature(LanguageFeature.PackageManagement) then - fsiDynamicCompiler.EvalDependencyManagerTextFragment(dependencyManager, directive, m, path) - istate, Completed None - else - errorR(Error(FSComp.SR.packageManagementRequiresVFive(), m)) - istate, Completed None - - | _, _ when directive = Directive.Include -> - errorR(Error(FSComp.SR.poundiNotSupportedByRegisteredDependencyManagers(), m)) - istate,Completed None - - | NonNull p, Null -> - let path = - if String.IsNullOrWhiteSpace(p) then "" - else p - let resolutions,istate = fsiDynamicCompiler.EvalRequireReference(ctok, istate, m, path) - resolutions |> List.iter (fun ar -> - let format = - if tcConfig.shadowCopyReferences then - let resolvedPath = ar.resolvedPath.ToUpperInvariant() - let fileTime = FileSystem.GetLastWriteTimeShim(resolvedPath) - match referencedAssemblies.TryGetValue resolvedPath with - | false, _ -> - referencedAssemblies.Add(resolvedPath, fileTime) - FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) - | true, time when time <> fileTime -> - FSIstrings.SR.fsiDidAHashrWithStaleWarning(ar.resolvedPath) - | _ -> - FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) - else - FSIstrings.SR.fsiDidAHashrWithLockWarning(ar.resolvedPath) - fsiConsoleOutput.uprintnfnn "%s" format) - istate,Completed None - - istate |> InteractiveCatch diagnosticsLogger (fun istate -> - match action with - | ParsedScriptInteraction.Definitions ([], _) -> - let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) - istate,Completed None - - | ParsedScriptInteraction.Definitions ([SynModuleDecl.Expr(expr, _)], _) -> - let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) - fsiDynamicCompiler.EvalParsedExpression(ctok, diagnosticsLogger, istate, expr) + /// Partially process a hash directive, leaving state in packageManagerLines and required assemblies + let PartiallyProcessHashDirective (ctok, istate, hash, diagnosticsLogger: DiagnosticsLogger) = + match hash with + | ParsedHashDirective("load", ParsedHashDirectiveArguments sourceFiles, m) -> + let istate = fsiDynamicCompiler.EvalSourceFiles (ctok, istate, m, sourceFiles, lexResourceManager, diagnosticsLogger) + istate, Completed None - | ParsedScriptInteraction.Definitions (defs,_) -> - let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) - fsiDynamicCompiler.EvalParsedDefinitions (ctok, diagnosticsLogger, istate, true, false, defs) + | ParsedHashDirective(("reference" | "r"), ParsedHashDirectiveArguments [path], m) -> + fsiDynamicCompiler.PartiallyProcessReferenceOrPackageIncudePathDirective (ctok, istate, Directive.Resolution, path, true, m) - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("load", ParsedHashDirectiveArguments sourceFiles, m), _) -> - let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) - fsiDynamicCompiler.EvalSourceFiles (ctok, istate, m, sourceFiles, lexResourceManager, diagnosticsLogger),Completed None + | ParsedHashDirective("i", ParsedHashDirectiveArguments [path], m) -> + fsiDynamicCompiler.PartiallyProcessReferenceOrPackageIncudePathDirective (ctok, istate, Directive.Include, path, true, m) - | ParsedScriptInteraction.HashDirective (ParsedHashDirective(("reference" | "r"), ParsedHashDirectiveArguments [path], m), _) -> - packageManagerDirective Directive.Resolution path m + | ParsedHashDirective("I", ParsedHashDirectiveArguments [path], m) -> + tcConfigB.AddIncludePath (m, path, tcConfigB.implicitIncludeDir) + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiDidAHashI(tcConfig.MakePathAbsolute path)) + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("i", ParsedHashDirectiveArguments [path], m), _) -> - packageManagerDirective Directive.Include path m + | ParsedHashDirective("cd", ParsedHashDirectiveArguments [path], m) -> + ChangeDirectory path m + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("I", ParsedHashDirectiveArguments [path], m), _) -> - tcConfigB.AddIncludePath (m, path, tcConfig.implicitIncludeDir) - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiDidAHashI(tcConfig.MakePathAbsolute path)) - istate, Completed None + | ParsedHashDirective("silentCd", ParsedHashDirectiveArguments [path], m) -> + ChangeDirectory path m + fsiConsolePrompt.SkipNext() (* "silent" directive *) + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("cd", ParsedHashDirectiveArguments [path], m), _) -> - ChangeDirectory path m - istate, Completed None + | ParsedHashDirective("dbgbreak", [], _) -> + let istate = {istate with debugBreak = true} + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("silentCd", ParsedHashDirectiveArguments [path], m), _) -> - ChangeDirectory path m - fsiConsolePrompt.SkipNext() (* "silent" directive *) - istate, Completed None - - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("dbgbreak", [], _), _) -> - {istate with debugBreak = true}, Completed None - - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("time", [], _), _) -> - if istate.timing then - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOff()) - else - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOn()) - {istate with timing = not istate.timing}, Completed None + | ParsedHashDirective("time", [], _) -> + if istate.timing then + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOff()) + else + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOn()) + let istate = {istate with timing = not istate.timing} + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("time", ParsedHashDirectiveArguments ["on" | "off" as v], _), _) -> - if v <> "on" then - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOff()) - else - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOn()) - {istate with timing = (v = "on")}, Completed None + | ParsedHashDirective("time", ParsedHashDirectiveArguments ["on" | "off" as v], _) -> + if v <> "on" then + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOff()) + else + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiTurnedTimingOn()) + let istate = {istate with timing = (v = "on")} + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("nowarn", ParsedHashDirectiveArguments numbers, m), _) -> - List.iter (fun (d:string) -> tcConfigB.TurnWarningOff(m, d)) numbers - istate, Completed None + | ParsedHashDirective("nowarn", ParsedHashDirectiveArguments numbers, m) -> + List.iter (fun (d:string) -> tcConfigB.TurnWarningOff(m, d)) numbers + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("terms", [], _), _) -> - tcConfigB.showTerms <- not tcConfig.showTerms - istate, Completed None + | ParsedHashDirective("terms", [], _) -> + tcConfigB.showTerms <- not tcConfigB.showTerms + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("types", [], _), _) -> - fsiOptions.ShowTypes <- not fsiOptions.ShowTypes - istate, Completed None + | ParsedHashDirective("types", [], _) -> + fsiOptions.ShowTypes <- not fsiOptions.ShowTypes + istate, Completed None - #if DEBUG - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("ilcode", [], _m), _) -> - fsiOptions.ShowILCode <- not fsiOptions.ShowILCode; - istate, Completed None +#if DEBUG + | ParsedHashDirective("ilcode", [], _m) -> + fsiOptions.ShowILCode <- not fsiOptions.ShowILCode; + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("info", [], _m), _) -> - PrintOptionInfo tcConfigB - istate, Completed None - #endif - | ParsedScriptInteraction.HashDirective (ParsedHashDirective(("clear"), [], _), _) -> - fsiOptions.ClearScreen() - istate, Completed None + | ParsedHashDirective("info", [], _m) -> + PrintOptionInfo tcConfigB + istate, Completed None +#endif + | ParsedHashDirective(("clear"), [], _) -> + fsiOptions.ClearScreen() + istate, Completed None - | ParsedScriptInteraction.HashDirective (ParsedHashDirective(("q" | "quit"), [], _), _) -> - fsiInterruptController.Exit() + | ParsedHashDirective(("q" | "quit"), [], _) -> + fsiInterruptController.Exit() + + | ParsedHashDirective("help", [], m) -> + fsiOptions.ShowHelp(m) + istate, Completed None + + | ParsedHashDirective(c, ParsedHashDirectiveArguments arg, m) -> + warning(Error((FSComp.SR.fsiInvalidDirective(c, String.concat " " arg)), m)) + istate, Completed None + + /// Most functions return a step status - this decides whether to continue and propogates the + /// last value produced + let ProcessStepStatus (istate, cont) lastResult f = + match cont with + | Completed newResult -> f newResult istate + // stop on error + | CompletedWithReportedError e -> istate, CompletedWithReportedError e + // stop on error + | CompletedWithAlreadyReportedError -> istate, CompletedWithAlreadyReportedError + // stop on EOF + | EndOfFile -> istate, Completed lastResult + // stop on CtrlC + | CtrlC -> istate, CtrlC + + /// Execute a group of interactions. Called on the GUI/execute/main thread. + /// The action is either a group of definitions or a group of hash-references. + let ExecuteInteractionGroup (ctok, istate, action: InteractionGroup, diagnosticsLogger: DiagnosticsLogger) = + istate |> InteractiveCatch diagnosticsLogger (fun istate -> + let rec loop istate action = + // These following actions terminate a dependency manager and/or references group + // - nothing left to do + // - a group of non-hash definitions + // - a #load + match action with + | InteractionGroup.Definitions _ + | InteractionGroup.HashDirectives [] + | InteractionGroup.HashDirectives (ParsedHashDirective("load", _, _) :: _) -> + if fsiDynamicCompiler.HasDelayedDependencyManagerText then + let istate = fsiDynamicCompiler.ProcessDelayedDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) + loop istate action + elif fsiDynamicCompiler.HasDelayedReferences then + let istate = fsiDynamicCompiler.ProcessDelayedReferences (ctok, istate) + loop istate action + else + match action with + | InteractionGroup.Definitions ([], _) + | InteractionGroup.HashDirectives [] -> + istate,Completed None + + | InteractionGroup.Definitions ([SynModuleDecl.Expr(expr, _)], _) -> + fsiDynamicCompiler.EvalParsedExpression(ctok, diagnosticsLogger, istate, expr) + + | InteractionGroup.Definitions (defs,_) -> + fsiDynamicCompiler.EvalParsedDefinitions (ctok, diagnosticsLogger, istate, true, false, defs) + + | InteractionGroup.HashDirectives (hash :: rest) -> + let status = PartiallyProcessHashDirective (ctok, istate, hash, diagnosticsLogger) + ProcessStepStatus status None (fun _ istate -> + loop istate (InteractionGroup.HashDirectives rest) + ) + + // Other hash directives do not terminate a dependency manager and/or references group + | InteractionGroup.HashDirectives (hash :: rest) -> + let status = PartiallyProcessHashDirective (ctok, istate, hash, diagnosticsLogger) + ProcessStepStatus status None (fun _ istate -> + loop istate (InteractionGroup.HashDirectives rest) + ) + + loop istate action + ) - | ParsedScriptInteraction.HashDirective (ParsedHashDirective("help", [], m), _) -> - fsiOptions.ShowHelp(m) - istate, Completed None + let isDefHash = function SynModuleDecl.HashDirective _ -> true | _ -> false - | ParsedScriptInteraction.HashDirective (ParsedHashDirective(c, ParsedHashDirectiveArguments arg, m), _) -> - warning(Error((FSComp.SR.fsiInvalidDirective(c, String.concat " " arg)), m)) - istate, Completed None - ) + // Only add automatic debugger breaks before 'let' or 'do' expressions with sequence points + let isBreakable def = + match def with + | SynModuleDecl.Let (bindings=SynBinding(debugPoint=DebugPointAtBinding.Yes _) :: _) -> true + | _ -> false /// Execute a single parsed interaction which may contain multiple items to be executed /// independently, because some are #directives. Called on the GUI/execute/main thread. /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, diagnosticsLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = + let rec ExecuteParsedInteractionInGroups (ctok, istate, synInteraction, diagnosticsLogger: DiagnosticsLogger, lastResult: FsiValue option, cancellationToken: CancellationToken) = cancellationToken.ThrowIfCancellationRequested() - let action,nextAction,istate = - match action with + let group, others, istate = + match synInteraction with | None -> None,None,istate - | Some (ParsedScriptInteraction.HashDirective _) -> action,None,istate + | Some (ParsedScriptInteraction.Definitions (defs,m)) -> + match defs with + | [] -> + None, None, istate - | Some (ParsedScriptInteraction.Definitions ([],_)) -> None,None,istate + | SynModuleDecl.HashDirective _ :: _ -> + let hashes = List.takeWhile isDefHash defs |> List.choose (function (SynModuleDecl.HashDirective(hash, _))-> Some(hash) | _ -> None) + let defsB = List.skipWhile isDefHash defs - | Some (ParsedScriptInteraction.Definitions (SynModuleDecl.HashDirective(hash,mh) :: defs,m)) -> - Some (ParsedScriptInteraction.HashDirective(hash,mh)),Some (ParsedScriptInteraction.Definitions(defs,m)),istate + let group = InteractionGroup.HashDirectives(hashes) + let others = ParsedScriptInteraction.Definitions(defsB, m) + Some group, Some others, istate - | Some (ParsedScriptInteraction.Definitions (defs,m)) -> - let isDefHash = function SynModuleDecl.HashDirective _ -> true | _ -> false - let isBreakable def = - // only add automatic debugger breaks before 'let' or 'do' expressions with sequence points - match def with - | SynModuleDecl.Let (bindings=SynBinding(debugPoint=DebugPointAtBinding.Yes _) :: _) -> true - | _ -> false - let defsA = Seq.takeWhile (isDefHash >> not) defs |> Seq.toList - let defsB = Seq.skipWhile (isDefHash >> not) defs |> Seq.toList - - // If user is debugging their script interactively, inject call - // to Debugger.Break() at the first "breakable" line. - // Update istate so that more Break() calls aren't injected when recursing - let defsA,istate = - if istate.debugBreak then - let preBreak = Seq.takeWhile (isBreakable >> not) defsA |> Seq.toList - let postBreak = Seq.skipWhile (isBreakable >> not) defsA |> Seq.toList - match postBreak with - | h :: _ -> preBreak @ (fsiDynamicCompiler.CreateDebuggerBreak(h.Range) :: postBreak), { istate with debugBreak = false } - | _ -> defsA, istate - else defsA,istate - - // When the last declaration has a shape of DoExp (i.e., non-binding), - // transform it to a shape of "let it = ", so we can refer it. - let defsA = - if not (isNil defsB) then defsA else - match defsA with - | [] -> defsA - | [_] -> defsA - | _ -> - match List.rev defsA with - | SynModuleDecl.Expr(expr, _) :: rest -> (rest |> List.rev) @ (fsiDynamicCompiler.BuildItBinding expr) - | _ -> defsA - - Some (ParsedScriptInteraction.Definitions(defsA,m)),Some (ParsedScriptInteraction.Definitions(defsB,m)),istate - - match action, lastResult with - | None, Some prev -> assert nextAction.IsNone; istate, prev - | None,_ -> assert nextAction.IsNone; istate, Completed None - | Some action, _ -> - let istate,cont = ExecInteraction (ctok, tcConfig, istate, action, diagnosticsLogger) - match cont with - | Completed _ -> execParsedInteractions (ctok, tcConfig, istate, nextAction, diagnosticsLogger, Some cont, cancellationToken) - | CompletedWithReportedError e -> istate,CompletedWithReportedError e (* drop nextAction on error *) - | CompletedWithAlreadyReportedError -> istate,CompletedWithAlreadyReportedError (* drop nextAction on error *) - | EndOfFile -> istate,defaultArg lastResult (Completed None) (* drop nextAction on EOF *) - | CtrlC -> istate,CtrlC (* drop nextAction on CtrlC *) + | _ -> + + let defsA = Seq.takeWhile (isDefHash >> not) defs |> Seq.toList + let defsB = Seq.skipWhile (isDefHash >> not) defs |> Seq.toList + + // If user is debugging their script interactively, inject call + // to Debugger.Break() at the first "breakable" line. + // Update istate so that more Break() calls aren't injected when recursing + let defsA,istate = + if istate.debugBreak then + let preBreak = Seq.takeWhile (isBreakable >> not) defsA |> Seq.toList + let postBreak = Seq.skipWhile (isBreakable >> not) defsA |> Seq.toList + match postBreak with + | h :: _ -> preBreak @ (fsiDynamicCompiler.CreateDebuggerBreak(h.Range) :: postBreak), { istate with debugBreak = false } + | _ -> defsA, istate + else defsA,istate + + // When the last declaration has a shape of DoExp (i.e., non-binding), + // transform it to a shape of "let it = ", so we can refer it. + let defsA = + if not (isNil defsB) then defsA else + match defsA with + | [] -> defsA + | [_] -> defsA + | _ -> + match List.rev defsA with + | SynModuleDecl.Expr(expr, _) :: rest -> (rest |> List.rev) @ (fsiDynamicCompiler.BuildItBinding expr) + | _ -> defsA + + let group = InteractionGroup.Definitions(defsA,m) + let others = ParsedScriptInteraction.Definitions(defsB,m) + Some group,Some others, istate + + match group with + | None -> + istate, Completed lastResult + | Some group -> + let status = ExecuteInteractionGroup (ctok, istate, group, diagnosticsLogger) + ProcessStepStatus status lastResult (fun lastResult istate -> + ExecuteParsedInteractionInGroups (ctok, istate, others, diagnosticsLogger, lastResult, cancellationToken)) /// Execute a single parsed interaction which may contain multiple items to be executed /// independently - let executeParsedInteractions (ctok, tcConfig, istate, action, diagnosticsLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = - let istate, completed = execParsedInteractions (ctok, tcConfig, istate, action, diagnosticsLogger, lastResult, cancellationToken) - match completed with - | Completed _ -> - let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) - istate, completed - | _ -> istate, completed + let ExecuteParsedInteraction (ctok, istate, synInteraction, diagnosticsLogger: DiagnosticsLogger, lastResult: FsiValue option, cancellationToken: CancellationToken) = + let status = ExecuteParsedInteractionInGroups (ctok, istate, synInteraction, diagnosticsLogger, lastResult, cancellationToken) + ProcessStepStatus status lastResult (fun lastResult istate -> + let rec loop istate = + if fsiDynamicCompiler.HasDelayedDependencyManagerText then + let istate = fsiDynamicCompiler.ProcessDelayedDependencyManagerText(ctok, istate, lexResourceManager, diagnosticsLogger) + loop istate + elif fsiDynamicCompiler.HasDelayedReferences then + let istate = fsiDynamicCompiler.ProcessDelayedReferences (ctok, istate) + loop istate + else + istate, Completed lastResult + loop istate) /// Execute a single parsed interaction on the parser/execute thread. let mainThreadProcessAction ctok action istate = @@ -2870,10 +2984,9 @@ type FsiInteractionProcessor let mutable result = Unchecked.defaultof<'a * FsiInteractionStepStatus> fsiInterruptController.ControlledExecution().Run( fun () -> - let tcConfig = TcConfig.Create(tcConfigB,validate=false) if progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction..." fsiInterruptController.InterruptAllowed <- InterruptCanRaiseException; - let res = action ctok tcConfig istate + let res = action ctok istate fsiInterruptController.ClearInterruptRequest() fsiInterruptController.InterruptAllowed <- InterruptIgnored result <- res) @@ -2898,17 +3011,17 @@ type FsiInteractionProcessor stopProcessingRecovery e range0; istate, CompletedWithReportedError e - let mainThreadProcessParsedInteractions ctok diagnosticsLogger (action, istate) cancellationToken = - istate |> mainThreadProcessAction ctok (fun ctok tcConfig istate -> - executeParsedInteractions (ctok, tcConfig, istate, action, diagnosticsLogger, None, cancellationToken)) + let ExecuteParsedInteractionOnMainThread (ctok, diagnosticsLogger, synInteraction, istate, cancellationToken) = + istate |> mainThreadProcessAction ctok (fun ctok istate -> + ExecuteParsedInteraction (ctok, istate, synInteraction, diagnosticsLogger, None, cancellationToken)) - let parseExpression (tokenizer:LexFilter.LexFilter) = + let ParseExpression (tokenizer:LexFilter.LexFilter) = reusingLexbufForParsing tokenizer.LexBuffer (fun () -> Parser.typedSequentialExprEOF (fun _ -> tokenizer.GetToken()) tokenizer.LexBuffer) - let mainThreadProcessParsedExpression ctok diagnosticsLogger (expr, istate) = + let ExecuteParsedExpressionOnMainThread (ctok, diagnosticsLogger, expr, istate) = istate |> InteractiveCatch diagnosticsLogger (fun istate -> - istate |> mainThreadProcessAction ctok (fun ctok _tcConfig istate -> + istate |> mainThreadProcessAction ctok (fun ctok istate -> fsiDynamicCompiler.EvalParsedExpression(ctok, diagnosticsLogger, istate, expr) )) let commitResult (istate, result) = @@ -2934,7 +3047,7 @@ type FsiInteractionProcessor /// During processing of startup scripts, this runs on the main thread. /// /// This is blocking: it reads until one chunk of input have been received, unless IsPastEndOfStream is true - member _.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter, diagnosticsLogger, ?cancellationToken: CancellationToken) = + member _.ParseAndExecuteInteractionFromLexbuf (runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter, diagnosticsLogger, ?cancellationToken: CancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -2947,21 +3060,21 @@ type FsiInteractionProcessor else - fsiConsolePrompt.Print(); + fsiConsolePrompt.Print() istate |> InteractiveCatch diagnosticsLogger (fun istate -> - if progress then fprintfn fsiConsoleOutput.Out "entering ParseInteraction..."; + if progress then fprintfn fsiConsoleOutput.Out "entering ParseInteraction..." // Parse the interaction. When FSI.EXE is waiting for input from the console the // parser thread is blocked somewhere deep this call. - let action = ParseInteraction tokenizer + let action = ParseInteraction tokenizer - if progress then fprintfn fsiConsoleOutput.Out "returned from ParseInteraction...calling runCodeOnMainThread..."; + if progress then fprintfn fsiConsoleOutput.Out "returned from ParseInteraction...calling runCodeOnMainThread..." // After we've unblocked and got something to run we switch // over to the run-thread (e.g. the GUI thread) - let res = istate |> runCodeOnMainThread (fun ctok istate -> mainThreadProcessParsedInteractions ctok diagnosticsLogger (action, istate) cancellationToken) + let res = istate |> runCodeOnMainThread (fun ctok istate -> ExecuteParsedInteractionOnMainThread (ctok, diagnosticsLogger, action, istate, cancellationToken)) - if progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res; + if progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res res) member _.CurrentState = currState @@ -2974,42 +3087,30 @@ type FsiInteractionProcessor // During the processing of the file, further filenames are // resolved relative to the home directory of the loaded file. WithImplicitHome (tcConfigB, directoryName sourceFile) (fun () -> - // An included script file may contain maybe several interaction blocks. - // We repeatedly parse and process these, until an error occurs. - - use fileStream = FileSystem.OpenFileForReadShim(sourceFile) - use reader = fileStream.GetReader(tcConfigB.inputCodePage, false) + // An included script file may parse several interaction blocks. + // We repeatedly parse and process these, until an error occurs. + use fileStream = FileSystem.OpenFileForReadShim(sourceFile) + use reader = fileStream.GetReader(tcConfigB.inputCodePage, false) - let tokenizer = fsiStdinLexerProvider.CreateIncludedScriptLexer (sourceFile, reader, diagnosticsLogger) - let rec run istate = - let istate,cont = processor.ParseAndExecOneSetOfInteractionsFromLexbuf ((fun f istate -> f ctok istate), istate, tokenizer, diagnosticsLogger) - match cont with Completed _ -> run istate | _ -> istate,cont + let tokenizer = fsiStdinLexerProvider.CreateIncludedScriptLexer (sourceFile, reader, diagnosticsLogger) - let istate,cont = run istate - - match cont with - | Completed _ -> failwith "EvalIncludedScript: Completed expected to have relooped" - | CompletedWithAlreadyReportedError -> istate,CompletedWithAlreadyReportedError - | CompletedWithReportedError e -> istate,CompletedWithReportedError e - | EndOfFile -> istate,Completed None// here file-EOF is normal, continue required - | CtrlC -> istate,CtrlC - ) + let rec run istate = + let status = processor.ParseAndExecuteInteractionFromLexbuf ((fun f istate -> f ctok istate), istate, tokenizer, diagnosticsLogger) + ProcessStepStatus status None (fun _ istate -> + run istate) + run istate + ) /// Load the source files, one by one. Called on the main thread. member processor.EvalIncludedScripts (ctok, istate, sourceFiles, diagnosticsLogger) = - match sourceFiles with - | [] -> istate + match sourceFiles with + | [] -> istate, Completed None | sourceFile :: moreSourceFiles -> // Catch errors on a per-file basis, so results/bindings from pre-error files can be kept. - let istate,cont = InteractiveCatch diagnosticsLogger (fun istate -> processor.EvalIncludedScript (ctok, istate, sourceFile, rangeStdin0, diagnosticsLogger)) istate - match cont with - | Completed _ -> processor.EvalIncludedScripts (ctok, istate, moreSourceFiles, diagnosticsLogger) - | CompletedWithAlreadyReportedError -> istate // do not process any more files - | CompletedWithReportedError _ -> istate // do not process any more files - | CtrlC -> istate // do not process any more files - | EndOfFile -> assert false; istate // This is unexpected. EndOfFile is replaced by Completed in the called function - + let status = InteractiveCatch diagnosticsLogger (fun istate -> processor.EvalIncludedScript (ctok, istate, sourceFile, rangeStdin0, diagnosticsLogger)) istate + ProcessStepStatus status None (fun _ istate -> + processor.EvalIncludedScripts (ctok, istate, moreSourceFiles, diagnosticsLogger)) member processor.LoadInitialFiles (ctok, diagnosticsLogger) = /// Consume initial source files in chunks of scripts or non-scripts @@ -3019,11 +3120,11 @@ type FsiInteractionProcessor | (_,isScript1) :: _ -> let sourceFiles,rest = List.takeUntil (fun (_,isScript2) -> isScript1 <> isScript2) sourceFiles let sourceFiles = List.map fst sourceFiles - let istate = + let istate, _ = if isScript1 then processor.EvalIncludedScripts (ctok, istate, sourceFiles, diagnosticsLogger) else - istate |> InteractiveCatch diagnosticsLogger (fun istate -> fsiDynamicCompiler.EvalSourceFiles(ctok, istate, rangeStdin0, sourceFiles, lexResourceManager, diagnosticsLogger), Completed None) |> fst + istate |> InteractiveCatch diagnosticsLogger (fun istate -> fsiDynamicCompiler.EvalSourceFiles(ctok, istate, rangeStdin0, sourceFiles, lexResourceManager, diagnosticsLogger), Completed None) consume istate rest setCurrState (consume currState fsiOptions.SourceFiles) @@ -3038,15 +3139,15 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseBuildPhase BuildPhase.Interactive + use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, diagnosticsLogger) currState |> InteractiveCatch diagnosticsLogger (fun istate -> let expr = ParseInteraction tokenizer - mainThreadProcessParsedInteractions ctok diagnosticsLogger (expr, istate) cancellationToken) + ExecuteParsedInteractionOnMainThread (ctok, diagnosticsLogger, expr, istate, cancellationToken)) |> commitResult member this.EvalScript (ctok, scriptPath, diagnosticsLogger) = @@ -3055,18 +3156,18 @@ type FsiInteractionProcessor this.EvalInteraction (ctok, sourceText, scriptPath, diagnosticsLogger) member _.EvalExpression (ctok, sourceText, scriptFileName, diagnosticsLogger) = - use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _unwind1 = UseBuildPhase BuildPhase.Interactive + use _unwind2 = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, diagnosticsLogger) currState |> InteractiveCatch diagnosticsLogger (fun istate -> - let expr = parseExpression tokenizer + let expr = ParseExpression tokenizer let m = expr.Range // Make this into "(); expr" to suppress generalization and compilation-as-function let exprWithSeq = SynExpr.Sequential (DebugPointAtSequential.SuppressExpr, true, SynExpr.Const (SynConst.Unit,m.StartRange), expr, m) - mainThreadProcessParsedExpression ctok diagnosticsLogger (exprWithSeq, istate)) + ExecuteParsedExpressionOnMainThread (ctok, diagnosticsLogger, exprWithSeq, istate)) |> commitResult member _.AddBoundValue(ctok, diagnosticsLogger, name, value: obj) = @@ -3108,12 +3209,12 @@ type FsiInteractionProcessor // Keep going until EndOfFile on the inReader or console let rec loop currTokenizer = - let istateNew,contNew = - processor.ParseAndExecOneSetOfInteractionsFromLexbuf (runCodeOnMainThread, currState, currTokenizer, diagnosticsLogger) + let istateNew, cont = + processor.ParseAndExecuteInteractionFromLexbuf (runCodeOnMainThread, currState, currTokenizer, diagnosticsLogger) setCurrState istateNew - match contNew with + match cont with | EndOfFile -> () | CtrlC -> loop (fsiStdinLexerProvider.CreateStdinLexer(diagnosticsLogger)) // After each interrupt, restart to a brand new tokenizer | CompletedWithAlreadyReportedError @@ -3122,7 +3223,6 @@ type FsiInteractionProcessor loop initialTokenizer - if progress then fprintfn fsiConsoleOutput.Out "- READER: Exiting stdinReaderThread"; with e -> stopProcessingRecovery e range0; @@ -3152,8 +3252,8 @@ type FsiInteractionProcessor let nenv = tcState.TcEnvFromImpls.NameEnv let nItems = ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox istate.tcGlobals amap rangeStdin0) rangeStdin0 ad lid false - let names = nItems |> List.map (fun d -> d.DisplayName) - let names = names |> List.filter (fun name -> name.StartsWithOrdinal(stem)) + let names = nItems |> List.map (fun d -> d.DisplayName) + let names = names |> List.filter (fun name -> name.StartsWithOrdinal(stem)) names member _.ParseAndCheckInteraction (legacyReferenceResolver, istate, text:string) = @@ -3162,7 +3262,6 @@ type FsiInteractionProcessor let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) fsiInteractiveChecker.ParseAndCheckInteraction(SourceText.ofString text) - //---------------------------------------------------------------------------- // Server mode: //---------------------------------------------------------------------------- @@ -3361,8 +3460,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i with e -> stopProcessingRecovery e range0; failwithf "Error creating evaluation session: %A" e - let niceNameGen = NiceNameGenerator() - // Share intern'd strings across all lexing/parsing let lexResourceManager = LexResourceManager() @@ -3382,7 +3479,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Some resolvedPath -> Some (Choice1Of2 resolvedPath) | None -> None - let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, niceNameGen, resolveAssemblyRef) + let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, resolveAssemblyRef) let controlledExecution = ControlledExecution() @@ -3424,6 +3521,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let dummyScriptFileName = "input.fsx" + let eagerFormat (diag : PhasedDiagnostic) = diag.EagerlyFormatCore true + interface IDisposable with member _.Dispose() = (tcImports :> IDisposable).Dispose() @@ -3542,7 +3641,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let ctok = AssumeCompilationThreadWithoutEvidence() let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions - let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions, eagerFormat) fsiInteractionProcessor.EvalExpression(ctok, code, dummyScriptFileName, diagnosticsLogger) |> commitResultNonThrowing errorOptions dummyScriptFileName diagnosticsLogger @@ -3564,7 +3663,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let cancellationToken = defaultArg cancellationToken CancellationToken.None let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions - let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions, eagerFormat) fsiInteractionProcessor.EvalInteraction(ctok, code, dummyScriptFileName, diagnosticsLogger, cancellationToken) |> commitResultNonThrowing errorOptions "input.fsx" diagnosticsLogger @@ -3585,7 +3684,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let ctok = AssumeCompilationThreadWithoutEvidence() let errorOptions = TcConfig.Create(tcConfigB, validate = false).diagnosticsOptions - let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let diagnosticsLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions, eagerFormat) fsiInteractionProcessor.EvalScript(ctok, filePath, diagnosticsLogger) |> commitResultNonThrowing errorOptions filePath diagnosticsLogger |> function Choice1Of2 _, errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs @@ -3636,7 +3735,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i if fsiOptions.IsInteractiveServer then SpawnInteractiveServer (fsi, fsiOptions, fsiConsoleOutput) - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Interactive + use _ = UseBuildPhase BuildPhase.Interactive if fsiOptions.Interact then // page in the type check env diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index 26b43155830..b4af719fa39 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -24,24 +24,21 @@ type internal InProcDiagnosticsLoggerProvider() = let warnings = ResizeArray() member _.Provider = - { new DiagnosticsLoggerProvider() with + { new IDiagnosticsLoggerProvider with - member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + member _.CreateLogger(tcConfigB, exiter) = - { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with member _.HandleTooManyErrors text = warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - member _.HandleIssue(tcConfigBuilder, err, severity) = + member _.HandleIssue(tcConfig, err, severity) = // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf - let diagnostics = - CollectFormattedDiagnostics - (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) + let diagnostics = CollectFormattedDiagnostics (tcConfig, severity, err, true) match severity with | FSharpDiagnosticSeverity.Error -> - errors.AddRange(diagnostics) + errors.AddRange(diagnostics) | FSharpDiagnosticSeverity.Warning -> warnings.AddRange(diagnostics) | _ -> ()} @@ -96,10 +93,7 @@ type internal InProcCompiler(legacyReferenceResolver) = let ctok = AssumeCompilationThreadWithoutEvidence () let loggerProvider = InProcDiagnosticsLoggerProvider() - let mutable exitCode = 0 - let exiter = - { new Exiter with - member _.Exit n = exitCode <- n; raise StopProcessing } + let exiter = StopProcessingExiter() try CompileFromCommandLineArguments ( ctok, argv, legacyReferenceResolver, @@ -111,14 +105,14 @@ type internal InProcCompiler(legacyReferenceResolver) = | StopProcessing -> () | ReportedError _ | WrappedError(ReportedError _,_) -> - exitCode <- 1 + exiter.ExitCode <- 1 () let output: CompilationOutput = { Warnings = loggerProvider.CapturedWarnings Errors = loggerProvider.CapturedErrors } - exitCode = 0, output + (exiter.ExitCode = 0), output /// in-proc version of fsc.exe type internal FscCompiler(legacyReferenceResolver) = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index b25b1c4ca72..479daef23c7 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -247,9 +247,7 @@ type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstanti // 'seq' in 'seq { ... }' gets colored as keywords | Item.Value vref, ItemOccurence.Use when valRefEq denv.g denv.g.seq_vref vref -> true // custom builders, custom operations get colored as keywords - | (Item.CustomBuilder _ - | Item.CustomOperation _), - ItemOccurence.Use -> true + | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use -> true | _ -> false member _.IsFromOpenStatement = itemOcc = ItemOccurence.Open @@ -2127,8 +2125,8 @@ type FSharpParsingOptions = module internal ParseAndCheckFile = - /// Error handler for parsing & type checking while processing a single file - type ErrorHandler + /// Diagnostics handler for parsing & type checking while processing a single file + type DiagnosticsHandler ( reportErrors, mainInputFileName, @@ -2180,7 +2178,7 @@ module internal ParseAndCheckFile = | _ -> collectOne severity diagnostic let diagnosticsLogger = - { new DiagnosticsLogger("ErrorHandler") with + { new DiagnosticsLogger("DiagnosticsHandler") with member _.DiagnosticSink(exn, severity) = diagnosticSink severity exn member _.ErrorCount = errorCount } @@ -2209,7 +2207,7 @@ module internal ParseAndCheckFile = IndentationAwareSyntaxStatus(indentationSyntaxStatus, true) - let createLexerFunction fileName options lexbuf (errHandler: ErrorHandler) = + let createLexerFunction fileName options lexbuf (errHandler: DiagnosticsHandler) = let indentationSyntaxStatus = getLightSyntaxStatus fileName options // If we're editing a script then we define INTERACTIVE otherwise COMPILED. @@ -2243,22 +2241,18 @@ module internal ParseAndCheckFile = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) let matchBraces (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = + // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseDiagnosticsLogger delayedLogger + use _ = UseBuildPhase BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) - // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors - let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let matchingBraces = ResizeArray<_>() usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> let errHandler = - ErrorHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) let lexfun = createLexerFunction fileName options lexbuf errHandler @@ -2310,14 +2304,8 @@ module internal ParseAndCheckFile = matchBraces stackAfterMatch - | LPAREN - | LBRACE _ - | LBRACK - | LBRACE_BAR - | LBRACK_BAR - | LQUOTE _ - | LBRACK_LESS as tok, - _ -> matchBraces ((tok, lexbuf.LexemeRange) :: stack) + | LPAREN | LBRACE _ | LBRACK | LBRACE_BAR | LBRACK_BAR | LQUOTE _ | LBRACK_LESS as tok, _ -> + matchBraces ((tok, lexbuf.LexemeRange) :: stack) // INTERP_STRING_BEGIN_PART corresponds to $"... {" at the start of an interpolated string // @@ -2326,9 +2314,7 @@ module internal ParseAndCheckFile = // interpolation expression) // // Either way we start a new potential match at the last character - | INTERP_STRING_BEGIN_PART _ - | INTERP_STRING_PART _ as tok, - _ -> + | INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _ as tok, _ -> let m = lexbuf.LexemeRange let m2 = @@ -2336,9 +2322,7 @@ module internal ParseAndCheckFile = matchBraces ((tok, m2) :: stack) - | (EOF _ - | LEX_FAILURE _), - _ -> () + | (EOF _ | LEX_FAILURE _), _ -> () | _ -> matchBraces stack matchBraces []) @@ -2347,15 +2331,14 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - use act = Activity.instance.Start "parseFile" [| "fileName", fileName |] + use act = Activity.Start "ParseAndCheckFile.parseFile" [| "fileName", fileName |] let errHandler = - ErrorHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) - use unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse let parseResult = usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> @@ -2403,8 +2386,8 @@ module internal ParseAndCheckFile = // If there was a loadClosure, replay the errors and warnings from resolution, excluding parsing loadClosure.LoadClosureRootFileDiagnostics |> List.iter diagnosticSink - let fileOfBackgroundError err = - match GetRangeOfDiagnostic(fst err) with + let fileOfBackgroundError (diagnostic: PhasedDiagnostic, _) = + match diagnostic.Range with | Some m -> Some m.FileName | None -> None @@ -2504,18 +2487,23 @@ module internal ParseAndCheckFile = ) = cancellable { - use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile + use _ = + Activity.Start + "ParseAndCheckFile.CheckOneFile" + [| + "mainInputFileName", mainInputFileName + "Length", sourceText.Length.ToString() + |] let parsedMainInput = parseResults.ParseTree // Initialize the error handler let errHandler = - ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) - use _unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use _unwindBP = UseBuildPhase BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = @@ -2532,11 +2520,6 @@ module internal ParseAndCheckFile = // If additional references were brought in by the preprocessor then we need to process them ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) - // A problem arises with nice name generation, which really should only - // be done in the backend, but is also done in the typechecker for better or worse. - // If we don't do this the NNG accumulates data and we get a memory leak. - tcState.NiceNameGenerator.Reset() - // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) @@ -2660,6 +2643,22 @@ type FSharpCheckFileResults | None -> [] | Some (scope, _builderOpt) -> scope.GetDeclarationListSymbols(parsedFileResults, line, lineText, partialName, getAllEntities) + member _.GetKeywordTooltip(names: string list) = + ToolTipText.ToolTipText + [ + for kw in names do + match Tokenization.FSharpKeywords.KeywordsDescriptionLookup kw with + | None -> () + | Some kwDescription -> + let kwText = kw |> TaggedText.tagKeyword |> wordL |> LayoutRender.toArray + let kwTip = ToolTipElementData.Create(kwText, FSharpXmlDoc.None) + + let descText = kwDescription |> TaggedText.tagText |> wordL |> LayoutRender.toArray + let descTip = ToolTipElementData.Create(descText, FSharpXmlDoc.None) + + yield ToolTipElement.Group [ kwTip; descTip ] + ] + /// Resolve the names at the given location to give a data tip member _.GetToolTip(line, colAtEndOfNames, lineText, names, tokenTag) = match tokenTagToTokenId tokenTag with diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index fc39764ff8c..6d60a75cc5b 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -313,6 +313,11 @@ type public FSharpCheckFileResults = ?getAllEntities: (unit -> AssemblySymbol list) -> FSharpSymbolUse list list + /// Compute a formatted tooltip for the given keywords + /// + /// The keywords at the location where the information is being requested. + member GetKeywordTooltip: names: string list -> ToolTipText + /// Compute a formatted tooltip for the given location /// /// The line number where the information is being requested. diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index fe5afbfc4ab..de8d6ae60da 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -937,7 +937,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let walkImplFile (modules: SynModuleOrNamespace list) = List.collect walkModule modules match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules + | ParsedInput.ImplFile file -> walkImplFile file.Contents | _ -> [] DiagnosticsScope.Protect diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 66d338a1b2b..5cc3367b76f 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -116,12 +116,7 @@ module IncrementalBuildSyntaxTree = let mutable weakCache: WeakReference<_> option = None let parse(sigNameOpt: QualifiedNameOfFile option) = - use act = - Activity.instance.Start "SyntaxTree.parse" - [| - "fileName", source.FilePath - "buildPhase", BuildPhase.Parse.ToString() - |] + let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) @@ -129,7 +124,13 @@ module IncrementalBuildSyntaxTree = try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) let canSkip = sigNameOpt.IsSome && FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) - act.AddTag "canSkip" canSkip + use act = + Activity.Start "IncrementalBuildSyntaxTree.parse" + [| + "fileName", source.FilePath + "buildPhase", BuildPhase.Parse.ToString() + "canSkip", canSkip.ToString() + |] let input = if canSkip then ParsedInput.ImplFile( @@ -472,7 +473,7 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> - use _ = Activity.instance.Start "TypeCheck" [|"fileName", syntaxTree.FileName|] + use _ = Activity.Start "BoundModel.TypeCheck" [|"fileName", syntaxTree.FileName|] let sigNameOpt = if partialCheck then this.BackingSignature @@ -483,7 +484,7 @@ type BoundModel private (tcConfig: TcConfig, IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") - let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) beforeFileChecked.Trigger fileName @@ -497,8 +498,6 @@ type BoundModel private (tcConfig: TcConfig, let hadParseErrors = not (Array.isEmpty parseErrors) let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - Logger.LogBlockMessageStart fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = CheckOneInput ((fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), @@ -510,9 +509,6 @@ type BoundModel private (tcConfig: TcConfig, partialCheck) |> NodeCode.FromCancellable - use _ = Activity.instance.StartNoTags("TypeCheck_BuildState") - Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck - fileChecked.Trigger fileName let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls @@ -528,8 +524,8 @@ type BoundModel private (tcConfig: TcConfig, tcDependencyFiles = fileName :: prevTcDependencyFiles sigNameOpt = match input with - | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> - Some(fileName, qualName) + | ParsedInput.SigFile sigFile -> + Some(sigFile.FileName, sigFile.QualifiedName) | _ -> None } @@ -540,7 +536,7 @@ type BoundModel private (tcConfig: TcConfig, // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then - Logger.LogBlockMessageStart fileName LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + use _ = Activity.Start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|"fileName",fileName|] let sResolutions = sink.GetResolutions() let builder = ItemKeyStoreBuilder() let preventDuplicates = HashSet({ new IEqualityComparer with @@ -558,7 +554,6 @@ type BoundModel private (tcConfig: TcConfig, sckBuilder.WriteAll semanticClassification let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification res else None, None @@ -754,7 +749,6 @@ module IncrementalBuilderHelpers = unresolvedReferences, dependencyProvider, loadClosureOpt: LoadClosure option, - niceNameGen, basicDependencies, keepAssemblyContents, keepAllBackgroundResolutions, @@ -803,7 +797,7 @@ module IncrementalBuilderHelpers = } let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitial, openDecls0) + let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) let loadClosureErrors = [ match loadClosureOpt with | None -> () @@ -1047,7 +1041,7 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { - use _ = Activity.instance.Start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|] + use _ = Activity.Start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|] // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = @@ -1442,7 +1436,9 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking: bool, - dependencyProvider + enableParallelCheckingWithSignatureFiles: bool, + dependencyProvider, + parallelReferenceResolution ) = let useSimpleResolutionSwitch = "--simpleresolution" @@ -1523,6 +1519,9 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc } |> Some + tcConfigB.parallelCheckingWithSignatureFiles <- enableParallelCheckingWithSignatureFiles + tcConfigB.parallelReferenceResolution <- parallelReferenceResolution + tcConfigB, sourceFilesNew // If this is a builder for a script, re-apply the settings inferred from the @@ -1551,7 +1550,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc setupConfigFromLoadClosure() let tcConfig = TcConfig.Create(tcConfigB, validate=true) - let niceNameGen = NiceNameGenerator() let outfile, _, assemblyName = tcConfigB.DecideNames sourceFiles // Resolve assemblies and create the framework TcImports. This is done when constructing the @@ -1635,7 +1633,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc unresolvedReferences, dependencyProvider, loadClosureOpt, - niceNameGen, basicDependencies, keepAssemblyContents, keepAllBackgroundResolutions, diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index cca65bcace1..481ed50689e 100755 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -263,7 +263,9 @@ type internal IncrementalBuilder = keepAllBackgroundSymbolUses: bool * enableBackgroundItemKeyStoreAndSemanticClassification: bool * enablePartialTypeChecking: bool * - dependencyProvider: DependencyProvider option -> + enableParallelCheckingWithSignatureFiles: bool * + dependencyProvider: DependencyProvider option * + parallelReferenceResolution: ParallelReferenceResolution -> NodeCode /// Generalized Incremental Builder. This is exposed only for unit testing purposes. diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index 5da02e32094..8fe50e9c241 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -212,10 +212,8 @@ module TcResolutionsExtensions = resolutions |> Array.iter (fun cnr -> match cnr.Item, cnr.ItemOccurence, cnr.Range with - | (Item.CustomBuilder _ - | Item.CustomOperation _), - ItemOccurence.Use, - m -> add m SemanticClassificationType.ComputationExpression + | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, m -> + add m SemanticClassificationType.ComputationExpression | Item.Value vref, _, m when isValRefMutable g vref -> add m SemanticClassificationType.MutableVar diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 17f8b27213d..399a3037eac 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -39,7 +39,7 @@ type ToolTipElementData = Remarks: TaggedText[] option ParamName : string option } - static member Create(layout, xml, ?typeMapping, ?paramName, ?remarks) = + static member internal Create(layout, xml, ?typeMapping, ?paramName, ?remarks) = { MainDescription=layout; XmlDoc=xml; TypeMapping=defaultArg typeMapping []; ParamName=paramName; Remarks=remarks } /// A single data tip display element diff --git a/src/Compiler/Service/ServiceDeclarationLists.fsi b/src/Compiler/Service/ServiceDeclarationLists.fsi index db07edf66ba..5bb8dcd9173 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fsi +++ b/src/Compiler/Service/ServiceDeclarationLists.fsi @@ -31,6 +31,8 @@ type public ToolTipElementData = ParamName: string option } + static member internal Create: layout: TaggedText[] * xml: FSharpXmlDoc * ?typeMapping: TaggedText[] list * ?paramName: string * ?remarks: TaggedText[] -> ToolTipElementData + /// A single tool tip display element // // Note: instances of this type do not hold any references to any compiler resources. diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs index 410d02dc786..bf28a121d43 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs @@ -780,8 +780,8 @@ module InterfaceStubGenerator = /// Find corresponding interface declaration at a given position let TryFindInterfaceDeclaration (pos: pos) (parsedInput: ParsedInput) = - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.tryPick walkSynModuleOrNamespace moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.tryPick walkSynModuleOrNamespace file.Contents and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; range = range)) = if not <| rangeContainsPos range pos then diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 884afb3901a..a772cd707aa 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -205,13 +205,9 @@ module internal TokenClassifications = // (this isn't entirely correct, but it'll work for now - see bug 3727) (FSharpTokenColorKind.Number, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) - | INFIX_STAR_DIV_MOD_OP ("mod" - | "land" - | "lor" - | "lxor") - | INFIX_STAR_STAR_OP ("lsl" - | "lsr" - | "asr") -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | INFIX_STAR_DIV_MOD_OP ("mod" | "land" | "lor" | "lxor") + | INFIX_STAR_STAR_OP ("lsl" | "lsr" | "asr") -> + (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) | LPAREN_STAR_RPAREN | DOLLAR @@ -1049,8 +1045,8 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi // Scan a token starting with the given lexer state member x.ScanToken(lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) + use _ = UseBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger DiscardErrorsLogger let indentationSyntaxStatus, lexcont = LexerStateEncoding.decodeLexInt lexState @@ -1216,6 +1212,14 @@ module FSharpKeywords = let KeywordsWithDescription = PrettyNaming.keywordsWithDescription + let internal KeywordsDescriptionLookup = + let d = KeywordsWithDescription |> dict + + fun kw -> + match d.TryGetValue kw with + | false, _ -> None + | true, desc -> Some desc + let KeywordNames = Lexhelp.Keywords.keywordNames [] @@ -1835,8 +1839,8 @@ module FSharpLexerImpl = else lexer - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) + use _ = UseBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger DiscardErrorsLogger resetLexbufPos "" lexbuf diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index 2c2b928febb..39b2febf315 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -344,6 +344,9 @@ module FSharpKeywords = /// Keywords paired with their descriptions. Used in completion and quick info. val KeywordsWithDescription: (string * string) list + /// A lookup from keywords to their descriptions + val internal KeywordsDescriptionLookup: (string -> string option) + /// All the keywords in the F# language val KeywordNames: string list diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index 11ebea8a668..c38ce9793e2 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -662,8 +662,8 @@ module NavigationImpl = module Navigation = let getNavigation (parsedInput: ParsedInput) = match parsedInput with - | ParsedInput.SigFile (ParsedSigFileInput (modules = modules)) -> NavigationImpl.getNavigationFromSigFile modules - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> NavigationImpl.getNavigationFromImplFile modules + | ParsedInput.SigFile file -> NavigationImpl.getNavigationFromSigFile file.Contents + | ParsedInput.ImplFile file -> NavigationImpl.getNavigationFromImplFile file.Contents let empty = NavigationItems([||]) @@ -819,15 +819,14 @@ module NavigateTo = let ctor = mapMemberKind memberFlags.MemberKind addValSig ctor valSig isSig container - let rec walkSigFileInput (inp: ParsedSigFileInput) = - let (ParsedSigFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp + let rec walkSigFileInput (file: ParsedSigFileInput) = - for item in moduleOrNamespaceList do + for item in file.Contents do walkSynModuleOrNamespaceSig item { Type = NavigableContainerType.File - LogicalName = fileName + LogicalName = file.FileName } and walkSynModuleOrNamespaceSig (inp: SynModuleOrNamespaceSig) container = @@ -890,15 +889,14 @@ module NavigateTo = | SynMemberSig.Interface _ -> () and walkImplFileInput (inp: ParsedImplFileInput) = - let (ParsedImplFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp let container = { Type = NavigableContainerType.File - LogicalName = fileName + LogicalName = inp.FileName } - for item in moduleOrNamespaceList do + for item in inp.Contents do walkSynModuleOrNamespace item container and walkSynModuleOrNamespace inp container = diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 9a4263d4975..f3443fd95ff 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -789,7 +789,8 @@ module SyntaxTraversal = match p with | SynPat.Paren (p, _) -> traversePat path p | SynPat.As (p1, p2, _) - | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path) + | SynPat.Or (p1, p2, _, _) + | SynPat.ListCons (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path) | SynPat.Ands (ps, _) | SynPat.Tuple (_, ps, _) | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path) @@ -797,7 +798,7 @@ module SyntaxTraversal = | SynPat.LongIdent (argPats = args) -> match args with | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path) - | SynArgPats.NamePatPairs (ps, _) -> ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path) + | SynArgPats.NamePatPairs (pats = ps) -> ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path) | SynPat.Typed (p, ty, _) -> match traversePat path p with | None -> traverseSynType path ty @@ -973,7 +974,9 @@ module SyntaxTraversal = visitor.VisitBinding(origPath, defaultTraverse, b) match parseTree with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) -> + | ParsedInput.ImplFile file -> + let l = file.Contents + let fileRange = #if DEBUG match l with diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 7b1fc766c1d..ef194965b34 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -556,7 +556,7 @@ module ParsedInput = let (|ConstructorPats|) pats = match pats with | SynArgPats.Pats ps -> ps - | SynArgPats.NamePatPairs (xs, _) -> List.map (fun (_, _, pat) -> pat) xs + | SynArgPats.NamePatPairs (pats = xs) -> List.map (fun (_, _, pat) -> pat) xs /// A recursive pattern that collect all sequential expressions to avoid StackOverflowException let rec (|Sequentials|_|) expr = @@ -570,8 +570,8 @@ module ParsedInput = let inline ifPosInRange range f = if isPosInRange range then f () else None - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.tryPick (walkSynModuleOrNamespace true) file.Contents and walkSynModuleOrNamespace isTopLevel inp = let (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs; range = r)) = @@ -581,7 +581,7 @@ module ParsedInput = |> Option.orElseWith (fun () -> ifPosInRange r (fun _ -> List.tryPick (walkSynModuleDecl isTopLevel) decls)) and walkAttribute (attr: SynAttribute) = - if isPosInRange attr.Range then + if isPosInRange attr.TypeName.Range then Some EntityKind.Attribute else None @@ -619,7 +619,8 @@ module ParsedInput = | SynPat.As (pat1, pat2, _) -> List.tryPick walkPat [ pat1; pat2 ] | SynPat.Typed (pat, t, _) -> walkPat pat |> Option.orElseWith (fun () -> walkType t) | SynPat.Attrib (pat, Attributes attrs, _) -> walkPat pat |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) - | SynPat.Or (pat1, pat2, _, _) -> List.tryPick walkPat [ pat1; pat2 ] + | SynPat.Or (pat1, pat2, _, _) + | SynPat.ListCons (pat1, pat2, _, _) -> List.tryPick walkPat [ pat1; pat2 ] | SynPat.LongIdent (typarDecls = typars; argPats = ConstructorPats pats; range = r) -> ifPosInRange r (fun _ -> kind) |> Option.orElseWith (fun () -> @@ -1566,7 +1567,7 @@ module ParsedInput = let (|ConstructorPats|) pats = match pats with | SynArgPats.Pats ps -> ps - | SynArgPats.NamePatPairs (xs, _) -> List.map (fun (_, _, pat) -> pat) xs + | SynArgPats.NamePatPairs (pats = xs) -> List.map (fun (_, _, pat) -> pat) xs /// Returns all `Ident`s and `LongIdent`s found in an untyped AST. let getLongIdents (parsedInput: ParsedInput) : IDictionary = @@ -1589,8 +1590,8 @@ module ParsedInput = let addIdent (ident: Ident) = identsByEndPos[ident.idRange.End] <- [ ident ] - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.iter walkSynModuleOrNamespace moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.iter walkSynModuleOrNamespace file.Contents and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs)) = List.iter walkAttribute attrs @@ -1638,7 +1639,8 @@ module ParsedInput = walkPat pat List.iter walkAttribute attrs | SynPat.As (pat1, pat2, _) - | SynPat.Or (pat1, pat2, _, _) -> List.iter walkPat [ pat1; pat2 ] + | SynPat.Or (pat1, pat2, _, _) + | SynPat.ListCons (pat1, pat2, _, _) -> List.iter walkPat [ pat1; pat2 ] | SynPat.LongIdent (longDotId = ident; typarDecls = typars; argPats = ConstructorPats pats) -> addLongIdentWithDots ident @@ -2035,10 +2037,7 @@ module ParsedInput = result <- Some(oldScope, oldPos, true) | Some (oldScope, oldPos, _), _ -> match kind, oldScope.Kind with - | (Namespace - | NestedModule - | TopModule), - OpenDeclaration + | (Namespace | NestedModule | TopModule), OpenDeclaration | _ when oldPos.Line <= line -> result <- Some( @@ -2069,8 +2068,8 @@ module ParsedInput = | _ -> None |> Option.map (fun r -> r.StartColumn) - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.iter (walkSynModuleOrNamespace []) moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.iter (walkSynModuleOrNamespace []) file.Contents and walkSynModuleOrNamespace (parent: LongIdent) modul = let (SynModuleOrNamespace (longId = ident; kind = kind; decls = decls; range = range)) = diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index cbc625f709b..210f3f4f9e8 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -1045,11 +1045,11 @@ module Structure = List.iter parseModuleSigDeclaration decls match parsedInput with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> - modules |> List.iter parseModuleOrNamespace + | ParsedInput.ImplFile file -> + file.Contents |> List.iter parseModuleOrNamespace getCommentRanges sourceLines - | ParsedInput.SigFile (ParsedSigFileInput (modules = moduleSigs)) -> - List.iter parseModuleOrNamespaceSigs moduleSigs + | ParsedInput.SigFile file -> + file.Contents |> List.iter parseModuleOrNamespaceSigs getCommentRanges sourceLines acc :> seq<_> diff --git a/src/Compiler/Service/ServiceXmlDocParser.fs b/src/Compiler/Service/ServiceXmlDocParser.fs index f0b137b4bb8..4a7eca7868d 100644 --- a/src/Compiler/Service/ServiceXmlDocParser.fs +++ b/src/Compiler/Service/ServiceXmlDocParser.fs @@ -25,6 +25,7 @@ module XmlDocParsing = | SynPat.Typed (pat, _type, _range) -> digNamesFrom pat | SynPat.Attrib (pat, _attrs, _range) -> digNamesFrom pat | SynPat.LongIdent(argPats = ConstructorPats pats) -> pats |> List.collect digNamesFrom + | SynPat.ListCons (p1, p2, _, _) -> List.collect digNamesFrom [ p1; p2 ] | SynPat.Tuple (_, pats, _range) -> pats |> List.collect digNamesFrom | SynPat.Paren (pat, _range) -> digNamesFrom pat | SynPat.OptionalVal (id, _) -> [ id.idText ] @@ -210,8 +211,7 @@ module XmlDocParsing = and getXmlDocablesInput input = match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = symModules)) -> - symModules |> List.collect getXmlDocablesSynModuleOrNamespace + | ParsedInput.ImplFile file -> file.Contents |> List.collect getXmlDocablesSynModuleOrNamespace | ParsedInput.SigFile _ -> [] // Get compiler options for the 'project' implied by a single script file diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 5fafdc544c2..fe068d87a82 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -85,19 +85,11 @@ module CompileHelpers = let mkCompilationDiagnosticsHandlers () = let diagnostics = ResizeArray<_>() - let diagnosticSink isError exn = - let main, related = SplitRelatedDiagnostics exn - - let oneDiagnostic e = - diagnostics.Add(FSharpDiagnostic.CreateFromException(e, isError, range0, true)) // Suggest names for errors - - oneDiagnostic main - List.iter oneDiagnostic related - let diagnosticsLogger = { new DiagnosticsLogger("CompileAPI") with - member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn + member _.DiagnosticSink(diag, isError) = + diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true)) // Suggest names for errors member _.ErrorCount = diagnostics @@ -106,20 +98,17 @@ module CompileHelpers = } let loggerProvider = - { new DiagnosticsLoggerProvider() with - member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = diagnosticsLogger + { new IDiagnosticsLoggerProvider with + member _.CreateLogger(_tcConfigB, _exiter) = diagnosticsLogger } diagnostics, diagnosticsLogger, loggerProvider let tryCompile diagnosticsLogger f = - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger diagnosticsLogger - let exiter = - { new Exiter with - member x.Exit n = raise StopProcessing - } + let exiter = StopProcessingExiter() try f exiter @@ -150,113 +139,6 @@ module CompileHelpers = diagnostics.ToArray(), result - let compileFromAsts - ( - ctok, - legacyReferenceResolver, - asts, - assemblyName, - outFile, - dependencies, - noframework, - pdbFile, - executable, - tcImportsCapture, - dynamicAssemblyCreator - ) = - - let diagnostics, diagnosticsLogger, loggerProvider = mkCompilationDiagnosticsHandlers () - - let executable = defaultArg executable true - - let target = - if executable then - CompilerTarget.ConsoleExe - else - CompilerTarget.Dll - - let result = - tryCompile diagnosticsLogger (fun exiter -> - CompileFromSyntaxTrees( - ctok, - legacyReferenceResolver, - ReduceMemoryFlag.Yes, - assemblyName, - target, - outFile, - pdbFile, - dependencies, - noframework, - exiter, - loggerProvider, - asts, - tcImportsCapture, - dynamicAssemblyCreator - )) - - diagnostics.ToArray(), result - - let createDynamicAssembly - (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) - (tcConfig: TcConfig, tcGlobals: TcGlobals, outfile, ilxMainModule) - = - - // Create an assembly builder - let assemblyName = AssemblyName(Path.GetFileNameWithoutExtension outfile) - let flags = AssemblyBuilderAccess.Run - let assemblyBuilder = System.Reflection.Emit.AssemblyBuilder.DefineDynamicAssembly(assemblyName, flags) - let moduleBuilder = assemblyBuilder.DefineDynamicModule("IncrementalModule") - - // Omit resources in dynamic assemblies, because the module builder is constructed without a file name the module - // is tagged as transient and as such DefineManifestResource will throw an invalid operation if resources are present. - // - // Also, the dynamic assembly creator can't currently handle types called "" from statically linked assemblies. - let ilxMainModule = - { ilxMainModule with - TypeDefs = - ilxMainModule.TypeDefs.AsList() - |> List.filter (fun td -> not (isTypeNameForGlobalFunctions td.Name)) - |> mkILTypeDefs - Resources = mkILResources [] - } - - // The function used to resolve types while emitting the code - let assemblyResolver s = - match tcImportsRef.Value.Value.TryFindExistingFullyQualifiedPathByExactAssemblyRef s with - | Some res -> Some(Choice1Of2 res) - | None -> None - - // Emit the code - let _emEnv, execs = - EmitDynamicAssemblyFragment( - tcGlobals.ilg, - tcConfig.emitTailcalls, - emEnv0, - assemblyBuilder, - moduleBuilder, - ilxMainModule, - debugInfo, - assemblyResolver, - tcGlobals.TryFindSysILTypeRef - ) - - // Execute the top-level initialization, if requested - if execute then - for exec in execs do - match exec () with - | None -> () - | Some exn -> - PreserveStackTrace exn - raise exn - - // Register the reflected definitions for the dynamically generated assembly - for resource in ilxMainModule.Resources.AsList() do - if IsReflectedDefinitionsResource resource then - Quotations.Expr.RegisterReflectedDefinitions(assemblyBuilder, moduleBuilder.Name, resource.GetBytes().ToArray()) - - // Save the result - assemblyBuilderRef.Value <- Some assemblyBuilder - let setOutputStreams execute = // Set the output streams, if requested match execute with @@ -292,7 +174,9 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles, + parallelReferenceResolution ) as self = let beforeFileChecked = Event() @@ -390,7 +274,9 @@ type BackgroundCompiler /// creates an incremental builder used by the command line compiler. let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = node { - use _ = Activity.instance.Start "CreateOneIncrementalBuilder" [| "project", options.ProjectFileName |] + use _ = + Activity.Start "BackgroundCompiler.CreateOneIncrementalBuilder" [| "project", options.ProjectFileName |] + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = getProjectReferences options userOpName @@ -420,7 +306,9 @@ type BackgroundCompiler keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, - dependencyProvider + enableParallelCheckingWithSignatureFiles, + dependencyProvider, + parallelReferenceResolution ) match builderOpt with @@ -517,9 +405,7 @@ type BackgroundCompiler | Some getBuilder -> node { match! getBuilder with - | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> - Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache - return builderOpt, creationDiags + | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags | _ -> // The builder could be re-created, // clear the check file caches that are associated with it. @@ -549,9 +435,7 @@ type BackgroundCompiler let getAnyBuilder (options, userOpName) = match tryGetAnyBuilder options with - | Some getBuilder -> - Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache - getBuilder + | Some getBuilder -> getBuilder | _ -> getOrCreateBuilder (options, userOpName) static let mutable actualParseFileCount = 0 @@ -583,7 +467,7 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { use _ = - Activity.instance.Start "CompileToDynamicAssembly1" [| "filename", fileName; "UserOpName", userOpName |] + Activity.Start "BackgroundCompiler.ParseFile" [| "filename", fileName; "UserOpName", userOpName; "cache", cache.ToString() |] if cache then let hash = sourceText.GetHashCode() |> int64 @@ -609,6 +493,9 @@ type BackgroundCompiler /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { + use _ = + Activity.Start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| "filename", fileName; "UserOpName", userOpName |] + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -636,6 +523,7 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { + use _ = Activity.Start "BackgroundCompiler.GetCachedCheckFileResult" [| "filename", fileName |] let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -739,8 +627,8 @@ type BackgroundCompiler ) = node { use _ = - Activity.instance.Start - "CheckFileInProjectAllowingStaleCachedResults" + Activity.Start + "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" [| "Project", options.ProjectFileName "filename", fileName @@ -781,8 +669,8 @@ type BackgroundCompiler member bc.CheckFileInProject(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = node { use _ = - Activity.instance.Start - "CheckFileInProject" + Activity.Start + "BackgroundCompiler.CheckFileInProject" [| "project", options.ProjectFileName "fileName", fileName @@ -809,17 +697,18 @@ type BackgroundCompiler member bc.ParseAndCheckFileInProject(fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = node { use _ = - Activity.instance.Start "Service_ParseAndCheckFileInProject" [| "project", options.ProjectFileName; "fileName", fileName |] - - let strGuid = "_ProjectId=" + (options.ProjectId |> Option.defaultValue "null") - Logger.LogBlockMessageStart (fileName + strGuid) LogCompilerFunctionId.Service_ParseAndCheckFileInProject + Activity.Start + "BackgroundCompiler.ParseAndCheckFileInProject" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with | None -> - Logger.LogBlockMessageStop (fileName + strGuid + "-Failed_Aborted") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - let parseTree = EmptyParsedInput(fileName, (false, false)) let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [||]) return (parseResults, FSharpCheckFileAnswer.Aborted) @@ -828,10 +717,7 @@ type BackgroundCompiler let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) match cachedResults with - | Some (parseResults, checkResults) -> - Logger.LogBlockMessageStop (fileName + strGuid + "-Successful_Cached") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - - return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) + | Some (parseResults, checkResults) -> return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) | _ -> let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() @@ -850,14 +736,21 @@ type BackgroundCompiler let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) - Logger.LogBlockMessageStop (fileName + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - return (parseResults, checkResults) } /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) = node { + use _ = + Activity.Start + "BackgroundCompiler.ParseAndCheckFileInProject" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -941,6 +834,16 @@ type BackgroundCompiler userOpName: string ) = node { + use _ = + Activity.Start + "BackgroundCompiler.FindReferencesInFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + "symbol", symbol.FullName + |] + let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (options, canInvalidateProject, userOpName) match builderOpt with @@ -959,6 +862,15 @@ type BackgroundCompiler member _.GetSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, userOpName: string) = node { + use _ = + Activity.Start + "BackgroundCompiler.GetSemanticClassificationForFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -974,6 +886,15 @@ type BackgroundCompiler /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = + use _ = + Activity.Start + "BackgroundCompiler.GetSemanticClassificationForFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", _userOpName + |] + match sourceText with | Some sourceText -> let hash = sourceText.GetHashCode() |> int64 @@ -1046,6 +967,9 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { + use _ = + Activity.Start "BackgroundCompiler.GetAssemblyData" [| "project", options.ProjectFileName; "userOpName", userOpName |] + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -1066,6 +990,9 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = + use _ = + Activity.Start "BackgroundCompiler.ParseAndCheckProject" [| "project", options.ProjectFileName; "userOpName", userOpName |] + bc.ParseAndCheckProjectImpl(options, userOpName) member _.GetProjectOptionsFromScript @@ -1082,6 +1009,9 @@ type BackgroundCompiler optionsStamp: int64 option, _userOpName ) = + use _ = + Activity.Start "BackgroundCompiler.GetProjectOptionsFromScript" [| "fileName", fileName; "userOpName", _userOpName |] + cancellable { use diagnostics = new DiagnosticsScope() @@ -1166,6 +1096,9 @@ type BackgroundCompiler |> Cancellable.toAsync member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = + use _ = + Activity.Start "BackgroundCompiler.InvalidateConfiguration" [| "project", options.ProjectFileName; "userOpName", userOpName |] + if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> for sourceFile in options.SourceFiles do @@ -1175,11 +1108,16 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = + use _ = Activity.Start "BackgroundCompiler.ClearCache" [| "userOpName", _userOpName |] + lock gate (fun () -> options |> Seq.iter (fun options -> incrementalBuildersCache.RemoveAnySimilar(AnyCallerThread, options))) member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = + use _ = + Activity.Start "BackgroundCompiler.NotifyProjectCleaned" [| "project", options.ProjectFileName; "userOpName", userOpName |] + async { let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This @@ -1199,6 +1137,8 @@ type BackgroundCompiler member _.ProjectChecked = projectChecked.Publish member _.ClearCaches() = + use _ = Activity.StartNoTags "BackgroundCompiler.ClearCaches" + lock gate (fun () -> parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.Clear(ltok) @@ -1209,6 +1149,8 @@ type BackgroundCompiler scriptClosureCache.Clear AnyCallerThread) member _.DownsizeCaches() = + use _ = Activity.StartNoTags "BackgroundCompiler.DownsizeCaches" + lock gate (fun () -> parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.Resize(ltok, newKeepStrongly = 1) @@ -1236,7 +1178,9 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles, + parallelReferenceResolution ) = let backgroundCompiler = @@ -1249,7 +1193,9 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles, + parallelReferenceResolution ) static let globalInstance = lazy FSharpChecker.Create() @@ -1261,6 +1207,24 @@ type FSharpChecker let braceMatchCache = MruCache(braceMatchCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) + static let inferParallelReferenceResolution (parallelReferenceResolution: bool option) = + let explicitValue = + parallelReferenceResolution + |> Option.defaultValue false + |> function + | true -> ParallelReferenceResolution.On + | false -> ParallelReferenceResolution.Off + + let withEnvOverride = + // Override ParallelReferenceResolution set on the constructor with an environment setting if present. + getParallelReferenceResolutionFromEnvironment () + |> Option.defaultValue explicitValue + + withEnvOverride + + static member getParallelReferenceResolutionFromEnvironment() = + getParallelReferenceResolutionFromEnvironment () + /// Instantiate an interactive checker. static member Create ( @@ -1272,9 +1236,13 @@ type FSharpChecker ?suggestNamesForErrors, ?keepAllBackgroundSymbolUses, ?enableBackgroundItemKeyStoreAndSemanticClassification, - ?enablePartialTypeChecking + ?enablePartialTypeChecking, + ?enableParallelCheckingWithSignatureFiles, + ?parallelReferenceResolution ) = + use _ = Activity.StartNoTags "FSharpChecker.Create" + let legacyReferenceResolver = match legacyReferenceResolver with | Some rr -> rr @@ -1291,10 +1259,13 @@ type FSharpChecker defaultArg enableBackgroundItemKeyStoreAndSemanticClassification false let enablePartialTypeChecking = defaultArg enablePartialTypeChecking false + let enableParallelCheckingWithSignatureFiles = defaultArg enableParallelCheckingWithSignatureFiles false if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." + let parallelReferenceResolution = inferParallelReferenceResolution parallelReferenceResolution + FSharpChecker( legacyReferenceResolver, projectCacheSizeReal, @@ -1304,13 +1275,16 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles, + parallelReferenceResolution ) member _.ReferenceResolver = legacyReferenceResolver member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" + use _ = Activity.Start "FSharpChecker.MatchBraces" [| "fileName", fileName; "userOpName", userOpName |] let hash = sourceText.GetHashCode() |> int64 async { @@ -1362,143 +1336,13 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" + use _ = Activity.Start "FSharpChecker.Compile" [| "userOpName", _userOpName |] async { let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) } - member _.Compile - ( - ast: ParsedInput list, - assemblyName: string, - outFile: string, - dependencies: string list, - ?pdbFile: string, - ?executable: bool, - ?noframework: bool, - ?userOpName: string - ) = - let _userOpName = defaultArg userOpName "Unknown" - - async { - let ctok = CompilationThreadToken() - let noframework = defaultArg noframework false - - return - CompileHelpers.compileFromAsts ( - ctok, - legacyReferenceResolver, - ast, - assemblyName, - outFile, - dependencies, - noframework, - pdbFile, - executable, - None, - None - ) - } - - member _.CompileToDynamicAssembly(otherFlags: string[], execute: (TextWriter * TextWriter) option, ?userOpName: string) = - let _userOpName = defaultArg userOpName "Unknown" - - async { - use _ = Activity.instance.Start "CompileToDynamicAssembly1" [| "UserOpName", _userOpName |] - let ctok = CompilationThreadToken() - CompileHelpers.setOutputStreams execute - - // References used to capture the results of compilation - let tcImportsRef = ref None - let assemblyBuilderRef = ref None - let tcImportsCapture = Some(fun tcImports -> tcImportsRef.Value <- Some tcImports) - - // Function to generate and store the results of compilation - let debugInfo = - otherFlags - |> Array.exists (fun arg -> arg = "-g" || arg = "--debug:+" || arg = "/debug:+") - - let dynamicAssemblyCreator = - Some(CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) - - // Perform the compilation, given the above capturing function. - let diagnostics, result = - CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) - - // Retrieve and return the results - let assemblyOpt = - match assemblyBuilderRef.Value with - | None -> None - | Some a -> Some(a :> Assembly) - - return diagnostics, result, assemblyOpt - } - - member _.CompileToDynamicAssembly - ( - ast: ParsedInput list, - assemblyName: string, - dependencies: string list, - execute: (TextWriter * TextWriter) option, - ?debug: bool, - ?noframework: bool, - ?userOpName: string - ) = - let _userOpName = defaultArg userOpName "Unknown" - - async { - use _ = - Activity.instance.Start "CompileToDynamicAssembly2" [| "Assembly", assemblyName; "UserOpName", _userOpName |] - - let ctok = CompilationThreadToken() - CompileHelpers.setOutputStreams execute - - // References used to capture the results of compilation - let tcImportsRef = ref (None: TcImports option) - let assemblyBuilderRef = ref None - let tcImportsCapture = Some(fun tcImports -> tcImportsRef.Value <- Some tcImports) - - let debugInfo = defaultArg debug false - let noframework = defaultArg noframework false - let location = Path.Combine(FileSystem.GetTempPathShim(), "test" + string (hash assemblyName)) - - try - Directory.CreateDirectory(location) |> ignore - with _ -> - () - - let outFile = Path.Combine(location, assemblyName + ".dll") - - // Function to generate and store the results of compilation - let dynamicAssemblyCreator = - Some(CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) - - // Perform the compilation, given the above capturing function. - let diagnostics, result = - CompileHelpers.compileFromAsts ( - ctok, - legacyReferenceResolver, - ast, - assemblyName, - outFile, - dependencies, - noframework, - None, - Some execute.IsSome, - tcImportsCapture, - dynamicAssemblyCreator - ) - - // Retrieve and return the results - let assemblyOpt = - match assemblyBuilderRef.Value with - | None -> None - | Some a -> Some(a :> Assembly) - - return diagnostics, result, assemblyOpt - } - /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. /// For example, the type provider approvals file may have changed. member ic.InvalidateAll() = ic.ClearCaches() @@ -1511,6 +1355,9 @@ type FSharpChecker // This is for unit testing only member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() = + use _ = + Activity.StartNoTags "FsharpChecker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients" + ic.ClearCaches() GC.Collect() GC.WaitForPendingFinalizers() @@ -1566,13 +1413,10 @@ type FSharpChecker options: FSharpProjectOptions, ?userOpName: string ) = - async { - let userOpName = defaultArg userOpName "Unknown" + let userOpName = defaultArg userOpName "Unknown" - return! - backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) - |> Async.AwaitNodeCode - } + backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) + |> Async.AwaitNodeCode /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. @@ -1584,34 +1428,16 @@ type FSharpChecker options: FSharpProjectOptions, ?userOpName: string ) = - async { - let userOpName = defaultArg userOpName "Unknown" - - use _ = - Activity.instance.Start - "ParseAndCheckFileInProject" - [| - "Project", options.ProjectFileName - "filename", fileName - "UserOpName", userOpName - |] + let userOpName = defaultArg userOpName "Unknown" - return! - backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) - |> Async.AwaitNodeCode - } + backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) + |> Async.AwaitNodeCode member _.ParseAndCheckProject(options, ?userOpName: string) = - async { - let userOpName = defaultArg userOpName "Unknown" - - use _ = - Activity.instance.Start "ParseAndCheckProject" [| "Project", options.ProjectFileName; "UserOpName", userOpName |] + let userOpName = defaultArg userOpName "Unknown" - return! - backgroundCompiler.ParseAndCheckProject(options, userOpName) - |> Async.AwaitNodeCode - } + backgroundCompiler.ParseAndCheckProject(options, userOpName) + |> Async.AwaitNodeCode member _.FindBackgroundReferencesInFile ( @@ -1621,29 +1447,17 @@ type FSharpChecker ?canInvalidateProject: bool, ?userOpName: string ) = - async { - let canInvalidateProject = defaultArg canInvalidateProject true - let userOpName = defaultArg userOpName "Unknown" - - use _ = - Activity.instance.Start "FindBackgroundReferencesInFile" [| "Project", options.ProjectFileName; "UserOpName", userOpName |] + let canInvalidateProject = defaultArg canInvalidateProject true + let userOpName = defaultArg userOpName "Unknown" - return! - backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) - |> Async.AwaitNodeCode - } + backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) + |> Async.AwaitNodeCode member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) = - async { - let userOpName = defaultArg userOpName "Unknown" - - use _ = - Activity.instance.Start "FindBackgroundReferencesInFile" [| "Project", options.ProjectFileName; "UserOpName", userOpName |] + let userOpName = defaultArg userOpName "Unknown" - return! - backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) - |> Async.AwaitNodeCode - } + backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) + |> Async.AwaitNodeCode /// For a given script file, get the ProjectOptions implied by the #load closure member _.GetProjectOptionsFromScript diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 25a5a2b412e..31801bfbf46 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -8,6 +8,7 @@ open System open System.IO open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols @@ -31,6 +32,8 @@ type public FSharpChecker = /// Indicate whether all symbol uses should be kept in background checking /// Indicates whether a table of symbol keys should be kept for background compilation /// Indicates whether to perform partial type checking. Cannot be set to true if keepAssmeblyContents is true. If set to true, can cause duplicate type-checks when richer information on a file is needed, but can skip background type-checking entirely on implementation files with signature files. + /// Type check implementation files that are backed by a signature file in parallel. + /// Indicates whether to resolve references in parallel. static member Create: ?projectCacheSize: int * ?keepAssemblyContents: bool * @@ -40,7 +43,9 @@ type public FSharpChecker = ?suggestNamesForErrors: bool * ?keepAllBackgroundSymbolUses: bool * ?enableBackgroundItemKeyStoreAndSemanticClassification: bool * - ?enablePartialTypeChecking: bool -> + ?enablePartialTypeChecking: bool * + ?enableParallelCheckingWithSignatureFiles: bool * + ?parallelReferenceResolution: bool -> FSharpChecker /// @@ -327,70 +332,6 @@ type public FSharpChecker = /// An optional string used for tracing compiler operations associated with this request. member Compile: argv: string[] * ?userOpName: string -> Async - /// - /// TypeCheck and compile provided AST - /// - /// - /// The syntax tree for the build. - /// The assembly name for the compiled output. - /// The output file for the compialtion. - /// The list of dependencies for the compialtion. - /// The output PDB file, if any. - /// Indicates if an executable is being produced. - /// Enables the /noframework flag. - /// An optional string used for tracing compiler operations associated with this request. - member Compile: - ast: ParsedInput list * - assemblyName: string * - outFile: string * - dependencies: string list * - ?pdbFile: string * - ?executable: bool * - ?noframework: bool * - ?userOpName: string -> - Async - - /// - /// Compiles to a dynamic assembly using the given flags. - /// - /// The first argument is ignored and can just be "fsc.exe". - /// - /// Any source files names are resolved via the FileSystem API. An output file name must be given by a -o flag, but this will not - /// be written - instead a dynamic assembly will be created and loaded. - /// - /// If the 'execute' parameter is given the entry points for the code are executed and - /// the given TextWriters are used for the stdout and stderr streams respectively. In this - /// case, a global setting is modified during the execution. - /// - /// - /// Other flags for compilation. - /// An optional pair of output streams, enabling execution of the result. - /// An optional string used for tracing compiler operations associated with this request. - member CompileToDynamicAssembly: - otherFlags: string[] * execute: (TextWriter * TextWriter) option * ?userOpName: string -> - Async - - /// - /// TypeCheck and compile provided AST - /// - /// - /// The syntax tree for the build. - /// The assembly name for the compiled output. - /// The list of dependencies for the compialtion. - /// An optional pair of output streams, enabling execution of the result. - /// Enabled debug symbols - /// Enables the /noframework flag. - /// An optional string used for tracing compiler operations associated with this request. - member CompileToDynamicAssembly: - ast: ParsedInput list * - assemblyName: string * - dependencies: string list * - execute: (TextWriter * TextWriter) option * - ?debug: bool * - ?noframework: bool * - ?userOpName: string -> - Async - /// /// Try to get type check results for a file. This looks up the results of recent type checks of the /// same file, regardless of contents. The version tag specified in the original check of the file is returned. diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index a99f02dbc44..c4b57e84c9f 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -71,10 +71,10 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(diagnostic, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic diagnostic with Some m -> m | None -> fallbackRange - let msg = buildString (fun buf -> OutputPhasedDiagnostic buf diagnostic false suggestNames) - let errorNum = GetDiagnosticNumber diagnostic + static member CreateFromException(diagnostic: PhasedDiagnostic, severity, fallbackRange: range, suggestNames: bool) = + let m = match diagnostic.Range with Some m -> m | None -> fallbackRange + let msg = diagnostic.FormatCore(false, suggestNames) + let errorNum = diagnostic.Number FSharpDiagnostic(m, severity, msg, diagnostic.Subcategory(), errorNum, "FS") /// Decompose a warning or error into parts: position, severity, message, error number @@ -104,16 +104,16 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str [] type DiagnosticsScope() = let mutable diags = [] - let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + let unwindBP = UseBuildPhase BuildPhase.TypeCheck let unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> + UseDiagnosticsLogger { new DiagnosticsLogger("DiagnosticsScope") with member _.DiagnosticSink(diagnostic, severity) = let diagnostic = FSharpDiagnostic.CreateFromException(diagnostic, severity, range.Zero, false) diags <- diagnostic :: diags - member _.ErrorCount = diags.Length }) + member _.ErrorCount = diags.Length } member _.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) @@ -126,7 +126,7 @@ type DiagnosticsScope() = interface IDisposable with member _.Dispose() = - unwindEL.Dispose() (* unwind pushes when DiagnosticsScope disposes *) + unwindEL.Dispose() unwindBP.Dispose() /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and @@ -158,53 +158,50 @@ type DiagnosticsScope() = | None -> err "" /// A diagnostics logger that capture diagnostics, filtering them according to warning levels etc. -type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDiagnosticOptions) = +type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDiagnosticOptions, ?preprocess: (PhasedDiagnostic -> PhasedDiagnostic)) = inherit DiagnosticsLogger("CompilationDiagnosticLogger("+debugName+")") let mutable errorCount = 0 let diagnostics = ResizeArray<_>() override _.DiagnosticSink(diagnostic, severity) = - if ReportDiagnosticAsError options (diagnostic, severity) then + let diagnostic = + match preprocess with + | Some f -> f diagnostic + | None -> diagnostic + + if diagnostic.ReportAsError (options, severity) then diagnostics.Add(diagnostic, FSharpDiagnosticSeverity.Error) errorCount <- errorCount + 1 - elif ReportDiagnosticAsWarning options (diagnostic, severity) then + elif diagnostic.ReportAsWarning (options, severity) then diagnostics.Add(diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo options (diagnostic, severity) then + elif diagnostic.ReportAsInfo (options, severity) then diagnostics.Add(diagnostic, severity) - + override _.ErrorCount = errorCount member _.GetDiagnostics() = diagnostics.ToArray() module DiagnosticHelpers = - let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, diagnostic, severity, suggestNames) = + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, diagnostic: PhasedDiagnostic, severity, suggestNames) = [ let severity = - if ReportDiagnosticAsError options (diagnostic, severity) then + if diagnostic.ReportAsError (options, severity) then FSharpDiagnosticSeverity.Error else severity if severity = FSharpDiagnosticSeverity.Error || - ReportDiagnosticAsWarning options (diagnostic, severity) || - ReportDiagnosticAsInfo options (diagnostic, severity) then - - let oneDiagnostic diagnostic = - [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. - // Not ideal, but it's hard to see what else to do. - let fallbackRange = rangeN mainInputFileName 1 - let diagnostic = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (diagnostic, severity, fallbackRange, fileInfo, suggestNames) - let fileName = diagnostic.Range.FileName - if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then - yield diagnostic ] - - let mainDiagnostic, relatedDiagnostics = SplitRelatedDiagnostics diagnostic - - yield! oneDiagnostic mainDiagnostic - - for e in relatedDiagnostics do - yield! oneDiagnostic e ] + diagnostic.ReportAsWarning (options, severity) || + diagnostic.ReportAsInfo (options, severity) then + + // We use the first line of the file as a fallbackRange for reporting unexpected errors. + // Not ideal, but it's hard to see what else to do. + let fallbackRange = rangeN mainInputFileName 1 + let diagnostic = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (diagnostic, severity, fallbackRange, fileInfo, suggestNames) + let fileName = diagnostic.Range.FileName + if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then + yield diagnostic ] let CreateDiagnostics (options, allErrors, mainInputFileName, diagnostics, suggestNames) = let fileInfo = (Int32.MaxValue, Int32.MaxValue) diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fsi b/src/Compiler/Symbols/FSharpDiagnostic.fsi index 2ebfcb71980..313c14240e4 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fsi +++ b/src/Compiler/Symbols/FSharpDiagnostic.fsi @@ -106,7 +106,9 @@ type internal CompilationDiagnosticLogger = inherit DiagnosticsLogger /// Create the diagnostics logger - new: debugName: string * options: FSharpDiagnosticOptions -> CompilationDiagnosticLogger + new: + debugName: string * options: FSharpDiagnosticOptions * ?preprocess: (PhasedDiagnostic -> PhasedDiagnostic) -> + CompilationDiagnosticLogger /// Get the captured diagnostics member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity)[] diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index ec343ad2a8d..9adb5ffb1f9 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -266,7 +266,10 @@ type FSharpSymbol(cenv: SymbolEnv, item: unit -> Item, access: FSharpSymbol -> C static member Create(cenv, item): FSharpSymbol = let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) - match item with + match item with + | Item.Value v when v.Deref.IsClassConstructor -> + FSharpMemberOrFunctionOrValue(cenv, C (FSMeth(cenv.g, generalizeTyconRef cenv.g v.DeclaringEntity |> snd, v, None)), item) :> _ + | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ @@ -632,8 +635,10 @@ type FSharpEntity(cenv: SymbolEnv, entity: EntityRef) = protect <| fun () -> ([ let entityTy = generalizedTyconRef cenv.g entity let createMember (minfo: MethInfo) = - if minfo.IsConstructor then FSharpMemberOrFunctionOrValue(cenv, C minfo, Item.CtorGroup (minfo.DisplayName, [minfo])) - else FSharpMemberOrFunctionOrValue(cenv, M minfo, Item.MethodGroup (minfo.DisplayName, [minfo], None)) + if minfo.IsConstructor || minfo.IsClassConstructor then + FSharpMemberOrFunctionOrValue(cenv, C minfo, Item.CtorGroup (minfo.DisplayName, [minfo])) + else + FSharpMemberOrFunctionOrValue(cenv, M minfo, Item.MethodGroup (minfo.DisplayName, [minfo], None)) if x.IsFSharpAbbreviation then () elif x.IsFSharp then diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 80fc0c21246..ee6b39a5a93 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -97,7 +97,7 @@ let mkLexargs /// Register the lexbuf and call the given function let reusingLexbufForParsing lexbuf f = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse LexbufLocalXmlDocStore.ClearXmlDoc lexbuf LexbufCommentStore.ClearComments lexbuf diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index f3e3fcdfdaf..ca0b858a0ba 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -13,6 +13,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml +open Internal.Utilities.Library open Internal.Utilities.Text.Lexing open Internal.Utilities.Text.Parsing @@ -468,6 +469,7 @@ let mkSynMemberDefnGetSet { LetKeyword = None EqualsRange = mEquals + ExternKeyword = None } let binding = @@ -542,6 +544,7 @@ let mkSynMemberDefnGetSet { LetKeyword = None EqualsRange = mEquals + ExternKeyword = None } let binding = @@ -629,6 +632,7 @@ let mkSynMemberDefnGetSet { LetKeyword = None EqualsRange = mEquals + ExternKeyword = None } let bindingOuter = @@ -857,3 +861,198 @@ let mkSynTypeTuple (elementTypes: SynTupleTypeSegment list) : SynType = ||> List.fold (fun acc segment -> unionRanges acc segment.Range) SynType.Tuple(false, elementTypes, range) + +#if DEBUG +let debugPrint s = + if Internal.Utilities.Text.Parsing.Flags.debug then + printfn "\n%s" s +#else +let debugPrint s = ignore s +#endif + +let exprFromParseError (e: SynExpr) = SynExpr.FromParseError(e, e.Range) + +let patFromParseError (e: SynPat) = SynPat.FromParseError(e, e.Range) + +// record bindings returned by the recdExprBindings rule has shape: +// (binding, separator-before-this-binding) +// this function converts arguments from form +// binding1 (binding2*sep1, binding3*sep2...) sepN +// to form +// binding1*sep1, binding2*sep2 +let rebindRanges first fields lastSep = + let rec run (name, mEquals, value) l acc = + match l with + | [] -> List.rev (SynExprRecordField(name, mEquals, value, lastSep) :: acc) + | (f, m) :: xs -> run f xs (SynExprRecordField(name, mEquals, value, m) :: acc) + + run first fields [] + +let mkUnderscoreRecdField m = + SynLongIdent([ ident ("_", m) ], [], [ None ]), false + +let mkRecdField (lidwd: SynLongIdent) = lidwd, true + +// Used for 'do expr' in a class. +let mkSynDoBinding (vis: SynAccess option, expr, m) = + match vis with + | Some vis -> errorR (Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (vis.ToString()), m)) + | None -> () + + SynBinding( + None, + SynBindingKind.Do, + false, + false, + [], + PreXmlDoc.Empty, + SynInfo.emptySynValData, + SynPat.Const(SynConst.Unit, m), + None, + expr, + m, + DebugPointAtBinding.NoneAtDo, + SynBindingTrivia.Zero + ) + +let mkSynExprDecl (e: SynExpr) = SynModuleDecl.Expr(e, e.Range) + +let addAttribs attrs p = SynPat.Attrib(p, attrs, p.Range) + +let unionRangeWithPos (r: range) p = + let r2 = mkRange r.FileName p p + unionRanges r r2 + +/// Report a good error at the end of file, e.g. for non-terminated strings +let checkEndOfFileError t = + match t with + | LexCont.IfDefSkip (_, _, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInHashIf ()) + + | LexCont.String (_, _, LexerStringStyle.SingleQuote, kind, m) -> + if kind.IsInterpolated then + reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedString ()) + else + reportParseErrorAt m (FSComp.SR.parsEofInString ()) + + | LexCont.String (_, _, LexerStringStyle.TripleQuote, kind, m) -> + if kind.IsInterpolated then + reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedTripleQuoteString ()) + else + reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteString ()) + + | LexCont.String (_, _, LexerStringStyle.Verbatim, kind, m) -> + if kind.IsInterpolated then + reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedVerbatimString ()) + else + reportParseErrorAt m (FSComp.SR.parsEofInVerbatimString ()) + + | LexCont.Comment (_, _, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInComment ()) + + | LexCont.SingleLineComment (_, _, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInComment ()) + + | LexCont.StringInComment (_, _, LexerStringStyle.SingleQuote, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInStringInComment ()) + + | LexCont.StringInComment (_, _, LexerStringStyle.Verbatim, _, m) -> + reportParseErrorAt m (FSComp.SR.parsEofInVerbatimStringInComment ()) + + | LexCont.StringInComment (_, _, LexerStringStyle.TripleQuote, _, m) -> + reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteStringInComment ()) + + | LexCont.MLOnly (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInIfOcaml ()) + + | LexCont.EndLine (_, _, LexerEndlineContinuation.Skip (_, m)) -> reportParseErrorAt m (FSComp.SR.parsEofInDirective ()) + + | LexCont.EndLine (endifs, nesting, LexerEndlineContinuation.Token) + | LexCont.Token (endifs, nesting) -> + match endifs with + | [] -> () + | (_, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsNoHashEndIfFound ()) + + match nesting with + | [] -> () + | (_, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill ()) + +type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * range + +let mkClassMemberLocalBindings + ( + isStatic, + initialRangeOpt, + attrs, + vis, + BindingSetPreAttrs (_, isRec, isUse, declsPreAttrs, bindingSetRange) + ) = + let ignoredFreeAttrs, decls = declsPreAttrs attrs vis + + let mWhole = + match initialRangeOpt with + | None -> bindingSetRange + | Some m -> unionRanges m bindingSetRange + // decls could have a leading attribute + |> fun m -> (m, decls) ||> unionRangeWithListBy (fun (SynBinding (range = m)) -> m) + + if not (isNil ignoredFreeAttrs) then + warning (Error(FSComp.SR.parsAttributesIgnored (), mWhole)) + + if isUse then + errorR (Error(FSComp.SR.parsUseBindingsIllegalInImplicitClassConstructors (), mWhole)) + + SynMemberDefn.LetBindings(decls, isStatic, isRec, mWhole) + +let mkLocalBindings (mWhole, BindingSetPreAttrs (_, isRec, isUse, declsPreAttrs, _), mIn, body: SynExpr) = + let ignoredFreeAttrs, decls = declsPreAttrs [] None + + let mWhole = + match decls with + | SynBinding (xmlDoc = xmlDoc) :: _ -> unionRangeWithXmlDoc xmlDoc mWhole + | _ -> mWhole + + if not (isNil ignoredFreeAttrs) then + warning (Error(FSComp.SR.parsAttributesIgnored (), mWhole)) + + let mIn = + mIn + |> Option.bind (fun (mIn: range) -> + if Position.posEq mIn.Start body.Range.Start then + None + else + Some mIn) + + SynExpr.LetOrUse(isRec, isUse, decls, body, mWhole, { InKeyword = mIn }) + +let mkDefnBindings (mWhole, BindingSetPreAttrs (_, isRec, isUse, declsPreAttrs, _bindingSetRange), attrs, vis, attrsm) = + if isUse then + warning (Error(FSComp.SR.parsUseBindingsIllegalInModules (), mWhole)) + + let freeAttrs, decls = declsPreAttrs attrs vis + // decls might have an extended range due to leading attributes + let mWhole = + (mWhole, decls) ||> unionRangeWithListBy (fun (SynBinding (range = m)) -> m) + + let letDecls = [ SynModuleDecl.Let(isRec, decls, mWhole) ] + + let attrDecls = + if not (isNil freeAttrs) then + [ SynModuleDecl.Attributes(freeAttrs, attrsm) ] + else + [] + + attrDecls @ letDecls + +let idOfPat (parseState: IParseState) m p = + match p with + | SynPat.Wild r when parseState.LexBuffer.SupportsFeature LanguageFeature.WildCardInForLoop -> mkSynId r "_" + | SynPat.Named (SynIdent (id, _), false, _, _) -> id + | SynPat.LongIdent (longDotId = SynLongIdent ([ id ], _, _); typarDecls = None; argPats = SynArgPats.Pats []; accessibility = None) -> + id + | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier ()) + +let checkForMultipleAugmentations m a1 a2 = + if not (isNil a1) && not (isNil a2) then + raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed ()) + + a1 @ a2 + +let rangeOfLongIdent (lid: LongIdent) = + System.Diagnostics.Debug.Assert(not lid.IsEmpty, "the parser should never produce a long-id that is the empty list") + (lid.Head.idRange, lid) ||> unionRangeWithListBy (fun id -> id.idRange) diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index e345dc68a3a..b5f9bac57f9 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -180,3 +180,56 @@ val mkSynMemberDefnGetSet: val adjustHatPrefixToTyparLookup: mFull: range -> rightExpr: SynExpr -> SynExpr val mkSynTypeTuple: elementTypes: SynTupleTypeSegment list -> SynType + +#if DEBUG +val debugPrint: s: string -> unit +#else +val debugPrint: s: 'a -> unit +#endif + +val exprFromParseError: e: SynExpr -> SynExpr + +val patFromParseError: e: SynPat -> SynPat + +val rebindRanges: + first: (RecordFieldName * range option * SynExpr option) -> + fields: ((RecordFieldName * range option * SynExpr option) * BlockSeparator option) list -> + lastSep: BlockSeparator option -> + SynExprRecordField list + +val mkUnderscoreRecdField: m: range -> SynLongIdent * bool + +val mkRecdField: lidwd: SynLongIdent -> SynLongIdent * bool + +val mkSynDoBinding: vis: SynAccess option * expr: SynExpr * m: range -> SynBinding + +val mkSynExprDecl: e: SynExpr -> SynModuleDecl + +val addAttribs: attrs: SynAttributes -> p: SynPat -> SynPat + +val unionRangeWithPos: r: range -> p: pos -> range + +val checkEndOfFileError: t: LexerContinuation -> unit + +type BindingSet = + | BindingSetPreAttrs of + range * + bool * + bool * + (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * + range + +val mkClassMemberLocalBindings: + isStatic: bool * initialRangeOpt: range option * attrs: SynAttributes * vis: SynAccess option * BindingSet -> + SynMemberDefn + +val mkLocalBindings: mWhole: range * BindingSet * mIn: range option * body: SynExpr -> SynExpr + +val mkDefnBindings: + mWhole: range * BindingSet * attrs: SynAttributes * vis: SynAccess option * attrsm: range -> SynModuleDecl list + +val idOfPat: parseState: IParseState -> m: range -> p: SynPat -> Ident + +val checkForMultipleAugmentations: m: range -> a1: 'a list -> a2: 'a list -> 'a list + +val rangeOfLongIdent: lid: LongIdent -> range diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index ce5571ab4d9..7ef394a67f0 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -47,10 +47,14 @@ type SynLongIdent = member this.IdentsWithTrivia = let (SynLongIdent (lid, _, trivia)) = this - if lid.Length <> trivia.Length then - failwith "difference between idents and trivia" - else + if lid.Length = trivia.Length then List.zip lid trivia |> List.map SynIdent + elif lid.Length > trivia.Length then + let delta = lid.Length - trivia.Length + let trivia = [ yield! trivia; yield! List.replicate delta None ] + List.zip lid trivia |> List.map SynIdent + else + failwith "difference between idents and trivia" member this.ThereIsAnExtraDotAtTheEnd = match this with @@ -882,12 +886,12 @@ type SynSimplePats = type SynArgPats = | Pats of pats: SynPat list - | NamePatPairs of pats: (Ident * range * SynPat) list * range: range + | NamePatPairs of pats: (Ident * range * SynPat) list * range: range * trivia: SynArgPatsNamePatPairsTrivia member x.Patterns = match x with | Pats pats -> pats - | NamePatPairs (pats, _) -> pats |> List.map (fun (_, _, pat) -> pat) + | NamePatPairs (pats = pats) -> pats |> List.map (fun (_, _, pat) -> pat) [] type SynPat = @@ -904,6 +908,8 @@ type SynPat = | Or of lhsPat: SynPat * rhsPat: SynPat * range: range * trivia: SynPatOrTrivia + | ListCons of lhsPat: SynPat * rhsPat: SynPat * range: range * trivia: SynPatListConsTrivia + | Ands of pats: SynPat list * range: range | As of lhsPat: SynPat * rhsPat: SynPat * range: range @@ -949,6 +955,7 @@ type SynPat = | SynPat.Wild (range = m) | SynPat.Named (range = m) | SynPat.Or (range = m) + | SynPat.ListCons (range = m) | SynPat.Ands (range = m) | SynPat.As (range = m) | SynPat.LongIdent (range = m) @@ -1644,10 +1651,7 @@ type ParsedSigFileFragment = trivia: SynModuleOrNamespaceSigTrivia [] -type ParsedScriptInteraction = - | Definitions of defns: SynModuleDecl list * range: range - - | HashDirective of hashDirective: ParsedHashDirective * range: range +type ParsedScriptInteraction = Definitions of defns: SynModuleDecl list * range: range [] type ParsedImplFile = ParsedImplFile of hashDirectives: ParsedHashDirective list * fragments: ParsedImplFileFragment list @@ -1676,10 +1680,32 @@ type ParsedImplFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespace list * - isLastCompiland: (bool * bool) * + contents: SynModuleOrNamespace list * + flags: (bool * bool) * trivia: ParsedImplFileInputTrivia + member x.QualifiedName = + (let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + + member x.ScopedPragmas = + (let (ParsedImplFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + + member x.HashDirectives = + (let (ParsedImplFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + + member x.FileName = (let (ParsedImplFileInput (fileName = fileName)) = x in fileName) + + member x.Contents = (let (ParsedImplFileInput (contents = contents)) = x in contents) + + member x.IsScript = (let (ParsedImplFileInput (isScript = isScript)) = x in isScript) + + member x.IsLastCompiland = + (let (ParsedImplFileInput (flags = (isLastCompiland, _))) = x in isLastCompiland) + + member x.IsExe = (let (ParsedImplFileInput (flags = (_, isExe))) = x in isExe) + + member x.Trivia = (let (ParsedImplFileInput (trivia = trivia)) = x in trivia) + [] type ParsedSigFileInput = | ParsedSigFileInput of @@ -1687,9 +1713,24 @@ type ParsedSigFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespaceSig list * + contents: SynModuleOrNamespaceSig list * trivia: ParsedSigFileInputTrivia + member x.QualifiedName = + (let (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + + member x.ScopedPragmas = + (let (ParsedSigFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + + member x.HashDirectives = + (let (ParsedSigFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + + member x.FileName = (let (ParsedSigFileInput (fileName = fileName)) = x in fileName) + + member x.Contents = (let (ParsedSigFileInput (contents = contents)) = x in contents) + + member x.Trivia = (let (ParsedSigFileInput (trivia = trivia)) = x in trivia) + [] type ParsedInput = | ImplFile of ParsedImplFileInput @@ -1698,12 +1739,21 @@ type ParsedInput = member inp.FileName = match inp with - | ParsedInput.ImplFile (ParsedImplFileInput (fileName = fileName)) - | ParsedInput.SigFile (ParsedSigFileInput (fileName = fileName)) -> fileName + | ParsedInput.ImplFile file -> file.FileName + | ParsedInput.SigFile file -> file.FileName + + member inp.ScopedPragmas = + match inp with + | ParsedInput.ImplFile file -> file.ScopedPragmas + | ParsedInput.SigFile file -> file.ScopedPragmas + + member inp.QualifiedName = + match inp with + | ParsedInput.ImplFile file -> file.QualifiedName + | ParsedInput.SigFile file -> file.QualifiedName member inp.Range = match inp with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = SynModuleOrNamespace (range = m) :: _)) - | ParsedInput.SigFile (ParsedSigFileInput(modules = SynModuleOrNamespaceSig (range = m) :: _)) -> m - | ParsedInput.ImplFile (ParsedImplFileInput (fileName = fileName)) - | ParsedInput.SigFile (ParsedSigFileInput (fileName = fileName)) -> rangeN fileName 0 + | ParsedInput.ImplFile (ParsedImplFileInput(contents = SynModuleOrNamespace (range = m) :: _)) + | ParsedInput.SigFile (ParsedSigFileInput(contents = SynModuleOrNamespaceSig (range = m) :: _)) -> m + | _ -> rangeN inp.FileName 0 diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 2af399af0e4..8d977a4c027 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -1024,7 +1024,7 @@ type SynSimplePats = type SynArgPats = | Pats of pats: SynPat list - | NamePatPairs of pats: (Ident * range * SynPat) list * range: range + | NamePatPairs of pats: (Ident * range * SynPat) list * range: range * trivia: SynArgPatsNamePatPairsTrivia member Patterns: SynPat list @@ -1050,6 +1050,9 @@ type SynPat = /// A disjunctive pattern 'pat1 | pat2' | Or of lhsPat: SynPat * rhsPat: SynPat * range: range * trivia: SynPatOrTrivia + /// A conjunctive pattern 'pat1 :: pat2' + | ListCons of lhsPat: SynPat * rhsPat: SynPat * range: range * trivia: SynPatListConsTrivia + /// A conjunctive pattern 'pat1 & pat2' | Ands of pats: SynPat list * range: range @@ -1839,10 +1842,7 @@ type ParsedSigFileFragment = /// Represents a parsed syntax tree for an F# Interactive interaction [] -type ParsedScriptInteraction = - | Definitions of defns: SynModuleDecl list * range: range - - | HashDirective of hashDirective: ParsedHashDirective * range: range +type ParsedScriptInteraction = Definitions of defns: SynModuleDecl list * range: range /// Represents a parsed implementation file made up of fragments [] @@ -1882,10 +1882,28 @@ type ParsedImplFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespace list * - isLastCompiland: (bool * bool) * + contents: SynModuleOrNamespace list * + flags: (bool * bool) * trivia: ParsedImplFileInputTrivia + member FileName: string + + member IsScript: bool + + member QualifiedName: QualifiedNameOfFile + + member ScopedPragmas: ScopedPragma list + + member HashDirectives: ParsedHashDirective list + + member Contents: SynModuleOrNamespace list + + member Trivia: ParsedImplFileInputTrivia + + member IsLastCompiland: bool + + member IsExe: bool + /// Represents the full syntax tree, file name and other parsing information for a signature file [] type ParsedSigFileInput = @@ -1894,9 +1912,21 @@ type ParsedSigFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespaceSig list * + contents: SynModuleOrNamespaceSig list * trivia: ParsedSigFileInputTrivia + member FileName: string + + member QualifiedName: QualifiedNameOfFile + + member ScopedPragmas: ScopedPragma list + + member HashDirectives: ParsedHashDirective list + + member Contents: SynModuleOrNamespaceSig list + + member Trivia: ParsedSigFileInputTrivia + /// Represents the syntax tree for a parsed implementation or signature file [] type ParsedInput = @@ -1911,3 +1941,9 @@ type ParsedInput = /// Gets the syntax range of this construct member Range: range + + /// Gets the qualified name used to help match signature and implementation files + member QualifiedName: QualifiedNameOfFile + + /// Gets the #nowarn and other scoped pragmas + member ScopedPragmas: ScopedPragma list diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index b36ec372a78..aefc238d10e 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -468,7 +468,7 @@ let mkSynDotMissing mDot m l = | SynExpr.LongIdent (isOpt, SynLongIdent (lid, dots, trivia), None, _) -> // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) SynExpr.LongIdent(isOpt, SynLongIdent(lid, dots @ [ mDot ], trivia), None, m) - | SynExpr.Ident id -> SynExpr.LongIdent(false, SynLongIdent([ id ], [ mDot ], []), None, m) + | SynExpr.Ident id -> SynExpr.LongIdent(false, SynLongIdent([ id ], [ mDot ], [ None ]), None, m) | SynExpr.DotGet (e, dm, SynLongIdent (lid, dots, trivia), _) -> SynExpr.DotGet(e, dm, SynLongIdent(lid, dots @ [ mDot ], trivia), m) // REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) | expr -> SynExpr.DiscardAfterMissingQualificationAfterDot(expr, m) @@ -1031,6 +1031,13 @@ let rec normalizeTupleExpr exprs commas : SynExpr list * range list = innerExprs @ rest, innerCommas @ commas | _ -> exprs, commas +let rec normalizeTuplePat pats : SynPat list = + match pats with + | SynPat.Tuple (false, innerPats, _) :: rest -> + let innerExprs = normalizeTuplePat (List.rev innerPats) + innerExprs @ rest + | _ -> pats + /// Remove all members that were captures as SynMemberDefn.GetSetMember let rec desugarGetSetMembers (memberDefns: SynMemberDefns) = memberDefns diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 5af8180d05e..b78563d4bce 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -350,6 +350,8 @@ val mkDynamicArgExpr: expr: SynExpr -> SynExpr val normalizeTupleExpr: exprs: SynExpr list -> commas: range list -> SynExpr list * range List +val normalizeTuplePat: pats: SynPat list -> SynPat list + val desugarGetSetMembers: memberDefns: SynMemberDefns -> SynMemberDefns val getTypeFromTuplePath: path: SynTupleTypeSegment list -> SynType list diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fs b/src/Compiler/SyntaxTree/SyntaxTrivia.fs index 1b03d20b615..fa4ebc784c8 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fs +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fs @@ -122,6 +122,9 @@ type SynUnionCaseTrivia = { BarRange: range option } [] type SynPatOrTrivia = { BarRange: range } +[] +type SynPatListConsTrivia = { ColonColonRange: range } + [] type SynTypeDefnTrivia = { @@ -156,12 +159,14 @@ type SynTypeDefnSigTrivia = type SynBindingTrivia = { LetKeyword: range option + ExternKeyword: range option EqualsRange: range option } static member Zero: SynBindingTrivia = { LetKeyword = None + ExternKeyword = None EqualsRange = None } @@ -257,3 +262,6 @@ type SynMemberGetSetTrivia = AndKeyword: range option SetKeyword: range option } + +[] +type SynArgPatsNamePatPairsTrivia = { ParenRange: range } diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi index fbdf8ecf30e..b6f0532d73c 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi @@ -199,6 +199,14 @@ type SynPatOrTrivia = BarRange: range } +/// Represents additional information for SynPat.Cons +[] +type SynPatListConsTrivia = + { + /// The syntax range of the `::` token. + ColonColonRange: range + } + /// Represents additional information for SynTypeDefn [] type SynTypeDefnTrivia = @@ -238,6 +246,9 @@ type SynBindingTrivia = /// The syntax range of the `let` keyword. LetKeyword: range option + /// The syntax range of the `extern` keyword. + ExternKeyword: range option + /// The syntax range of the `=` token. EqualsRange: range option } @@ -365,3 +376,11 @@ type SynMemberGetSetTrivia = /// The syntax range of the `set` keyword SetKeyword: range option } + +/// Represents additional information for SynArgPats.NamePatPairs +[] +type SynArgPatsNamePatPairsTrivia = + { + /// The syntax range from the beginning of the `(` token till the end of the `)` token. + ParenRange: range + } diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index e419be25d00..b7eea4fb718 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -20,7 +20,7 @@ type NiceNameGenerator() = let lockObj = obj() let basicNameCounts = Dictionary(100) - member x.FreshCompilerGeneratedName (name, m: range) = + member _.FreshCompilerGeneratedName (name, m: range) = lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let n = @@ -31,7 +31,7 @@ type NiceNameGenerator() = basicNameCounts[basicName] <- n + 1 nm) - member x.Reset () = + member _.Reset () = lock lockObj (fun () -> basicNameCounts.Clear() ) diff --git a/src/Compiler/TypedTree/QuotationPickler.fsi b/src/Compiler/TypedTree/QuotationPickler.fsi index 648e9d0acf6..fb7dbd2be5a 100644 --- a/src/Compiler/TypedTree/QuotationPickler.fsi +++ b/src/Compiler/TypedTree/QuotationPickler.fsi @@ -2,6 +2,7 @@ /// Code to pickle out quotations in the quotation binary format. module internal FSharp.Compiler.QuotationPickler + #nowarn "1178" type TypeData diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index c0b48c22584..662081a1f45 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -34,7 +34,7 @@ type ResolutionEnvironment = { ResolutionFolder: string OutputFile: string option ShowResolutionMessages: bool - ReferencedAssemblies: string[] + GetReferencedAssemblies: unit -> string[] TemporaryFolder: string } /// Load a the design-time part of a type-provider into the host process, and look for types @@ -118,19 +118,32 @@ let CreateTypeProvider ( let e = StripException (StripException err) raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(e.Message), typeProviderImplementationType.FullName, m)) + let getReferencedAssemblies () = + resolutionEnvironment.GetReferencedAssemblies() |> Array.distinct + if typeProviderImplementationType.GetConstructor([| typeof |]) <> null then // Create the TypeProviderConfig to pass to the type provider constructor let e = - TypeProviderConfig(systemRuntimeContainsType, +#if FSHARPCORE_USE_PACKAGE + TypeProviderConfig(systemRuntimeContainsType, + ReferencedAssemblies=getReferencedAssemblies(), ResolutionFolder=resolutionEnvironment.ResolutionFolder, RuntimeAssembly=runtimeAssemblyPath, - ReferencedAssemblies=Array.copy resolutionEnvironment.ReferencedAssemblies, TemporaryFolder=resolutionEnvironment.TemporaryFolder, IsInvalidationSupported=isInvalidationSupported, IsHostedExecution= isInteractive, SystemRuntimeAssemblyVersion = systemRuntimeAssemblyVersion) - +#else + TypeProviderConfig(systemRuntimeContainsType, + getReferencedAssemblies, + ResolutionFolder=resolutionEnvironment.ResolutionFolder, + RuntimeAssembly=runtimeAssemblyPath, + TemporaryFolder=resolutionEnvironment.TemporaryFolder, + IsInvalidationSupported=isInvalidationSupported, + IsHostedExecution= isInteractive, + SystemRuntimeAssemblyVersion = systemRuntimeAssemblyVersion) +#endif protect (fun () -> Activator.CreateInstance(typeProviderImplementationType, [| box e|]) :?> ITypeProvider ) elif typeProviderImplementationType.GetConstructor [| |] <> null then diff --git a/src/Compiler/TypedTree/TypeProviders.fsi b/src/Compiler/TypedTree/TypeProviders.fsi index 5d014938ea3..b1e3ccaf85c 100755 --- a/src/Compiler/TypedTree/TypeProviders.fsi +++ b/src/Compiler/TypedTree/TypeProviders.fsi @@ -37,7 +37,7 @@ type ResolutionEnvironment = ShowResolutionMessages: bool /// All referenced assemblies, including the type provider itself, and possibly other type providers. - ReferencedAssemblies: string[] + GetReferencedAssemblies: unit -> string[] /// The folder for temporary files TemporaryFolder: string diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index b3fcdd6c7d5..dfdc9640a0c 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4156,7 +4156,7 @@ type TType = (match anonInfo.TupInfo with | TupInfo.Const false -> "" | TupInfo.Const true -> "struct ") - + "{|" + String.concat "," (Seq.map2 (fun nm ty -> nm + " " + string ty + ";") anonInfo.SortedNames tinst) + ")" + "|}" + + "{|" + String.concat "," (Seq.map2 (fun nm ty -> nm + " " + string ty + ";") anonInfo.SortedNames tinst) + "|}" | TType_fun (domainTy, retTy, _) -> "(" + string domainTy + " -> " + string retTy + ")" | TType_ucase (uc, tinst) -> "ucase " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") | TType_var (tp, _) -> diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index d55e5e40706..b63942d2c8c 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3923,7 +3923,7 @@ type CheckedImplFile = member Signature: ModuleOrNamespaceType -/// Represents a complete typechecked assembly, made up of multiple implementation files. +/// Represents checked file, after optimization, equipped with the ability to do further optimization of expressions. [] type CheckedImplFileAfterOptimization = { ImplFile: CheckedImplFile diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 6678298f4b8..c166230e718 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10040,60 +10040,64 @@ let (|IfUseResumableStateMachinesExpr|_|) g expr = /// Combine a list of ModuleOrNamespaceType's making up the description of a CCU. checking there are now /// duplicate modules etc. -let CombineCcuContentFragments m l = +let CombineCcuContentFragments l = /// Combine module types when multiple namespace fragments contribute to the /// same namespace, making new module specs as we go. - let rec CombineModuleOrNamespaceTypes path m (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = - match mty1.ModuleOrNamespaceKind, mty2.ModuleOrNamespaceKind with - | Namespace _, Namespace _ -> - let kind = mty1.ModuleOrNamespaceKind - let tab1 = mty1.AllEntitiesByLogicalMangledName - let tab2 = mty2.AllEntitiesByLogicalMangledName - let entities = - [ for e1 in mty1.AllEntities do - match tab2.TryGetValue e1.LogicalName with - | true, e2 -> yield CombineEntities path e1 e2 - | _ -> yield e1 - for e2 in mty2.AllEntities do - match tab1.TryGetValue e2.LogicalName with - | true, _ -> () - | _ -> yield e2 ] - - let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers - - ModuleOrNamespaceType(kind, vals, QueueList.ofList entities) - - | Namespace _, _ | _, Namespace _ -> - error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path), m)) - - | _-> - error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path), m)) + let rec CombineModuleOrNamespaceTypes path (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = + let kind = mty1.ModuleOrNamespaceKind + let tab1 = mty1.AllEntitiesByLogicalMangledName + let tab2 = mty2.AllEntitiesByLogicalMangledName + let entities = + [ + for e1 in mty1.AllEntities do + match tab2.TryGetValue e1.LogicalName with + | true, e2 -> yield CombineEntities path e1 e2 + | _ -> yield e1 + + for e2 in mty2.AllEntities do + match tab1.TryGetValue e2.LogicalName with + | true, _ -> () + | _ -> yield e2 + ] + + let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers + + ModuleOrNamespaceType(kind, vals, QueueList.ofList entities) and CombineEntities path (entity1: Entity) (entity2: Entity) = - match entity1.IsModuleOrNamespace, entity2.IsModuleOrNamespace with - | true, true -> - entity1 |> Construct.NewModifiedTycon (fun data1 -> - let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc - { data1 with - entity_attribs = entity1.Attribs @ entity2.Attribs - entity_modul_type = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) - entity_opt_data = - match data1.entity_opt_data with - | Some optData -> Some { optData with entity_xmldoc = xml } - | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = xml } }) - | false, false -> - error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) - | _, _ -> - error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + let path2 = path@[entity2.DemangledModuleOrNamespaceName] + + match entity1.IsNamespace, entity2.IsNamespace, entity1.IsModule, entity2.IsModule with + | true, true, _, _ -> + () + | true, _, _, _ + | _, true, _, _ -> + errorR(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path2), entity2.Range)) + | false, false, false, false -> + errorR(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + | false, false, true, true -> + errorR(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path2), entity2.Range)) + | _ -> + errorR(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + + entity1 |> Construct.NewModifiedTycon (fun data1 -> + let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc + { data1 with + entity_attribs = entity1.Attribs @ entity2.Attribs + entity_modul_type = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes path2 entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) + entity_opt_data = + match data1.entity_opt_data with + | Some optData -> Some { optData with entity_xmldoc = xml } + | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = xml } }) - and CombineModuleOrNamespaceTypeList path m l = + and CombineModuleOrNamespaceTypeList path l = match l with - | h :: t -> List.fold (CombineModuleOrNamespaceTypes path m) h t + | h :: t -> List.fold (CombineModuleOrNamespaceTypes path) h t | _ -> failwith "CombineModuleOrNamespaceTypeList" - CombineModuleOrNamespaceTypeList [] m l + CombineModuleOrNamespaceTypeList [] l /// An immutable mappping from witnesses to some data. /// @@ -10406,18 +10410,4 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC Some emptyModuleOrNamespaces else None - | _ -> None - -let (|TTypeMultiDimensionalArrayAsGeneric|_|) (t: TType) = - let rec (|Impl|_|) t = - match t with - | TType_app(tc, [Impl(outerTc, innerT, currentLevel)], _) when tc.DisplayNameCore = "array" -> - Some (outerTc, innerT, currentLevel + 1) - | TType_app(tc, [arg], _) when tc.DisplayNameCore = "array" -> - Some (tc, arg, 1) - | _ -> None - - match t with - | Impl (tc, arg, level) -> - if level > 2 then Some (tc, arg, level) else None - | _ -> None + | _ -> None \ No newline at end of file diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index c4afc142086..00d838e04d4 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2565,7 +2565,7 @@ val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * Expr * Expr * /// Match 'if __useResumableCode then ... else ...' expressions val (|IfUseResumableStateMachinesExpr|_|): TcGlobals -> Expr -> (Expr * Expr) option -val CombineCcuContentFragments: range -> ModuleOrNamespaceType list -> ModuleOrNamespaceType +val CombineCcuContentFragments: ModuleOrNamespaceType list -> ModuleOrNamespaceType /// Recognise a 'match __resumableEntry() with ...' expression val (|ResumableEntryMatchExpr|_|): g: TcGlobals -> Expr -> (Expr * Val * Expr * (Expr * Expr -> Expr)) option @@ -2687,6 +2687,3 @@ type TraitConstraintInfo with /// This will match anything that does not have any types or bindings. val (|EmptyModuleOrNamespaces|_|): moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option - -/// Captures an application type with a multi-dimensional array as postfix. -val (|TTypeMultiDimensionalArrayAsGeneric|_|): t: TType -> (TyconRef * TType * int) option diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 6eab1b08508..fcb2a84c35b 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -10,7 +10,7 @@ open System.IO open System.Threading open System.Threading.Tasks open System.Runtime.CompilerServices -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE open FSharp.Core.CompilerServices.StateMachineHelpers #endif @@ -610,7 +610,7 @@ module ResizeArray = // * doing a block copy using `List.CopyTo(index, array, index, count)` (requires more copies to do the mapping) // none are significantly better. for i in 0 .. takeCount - 1 do - holder[i] <- f items[i] + holder[i] <- f items[startIndex + i] yield holder |] @@ -931,7 +931,7 @@ type CancellableBuilder() = member inline _.Bind(comp, [] k) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif @@ -941,7 +941,7 @@ type CancellableBuilder() = member inline _.BindReturn(comp, [] k) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif @@ -951,7 +951,7 @@ type CancellableBuilder() = member inline _.Combine(comp1, comp2) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif @@ -961,7 +961,7 @@ type CancellableBuilder() = member inline _.TryWith(comp, [] handler) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif @@ -982,7 +982,7 @@ type CancellableBuilder() = member inline _.Using(resource, [] comp) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif let body = comp resource @@ -1006,7 +1006,7 @@ type CancellableBuilder() = member inline _.TryFinally(comp, [] compensation) = Cancellable(fun ct -> -#if !USE_SHIPPED_FSCORE +#if !FSHARPCORE_USE_PACKAGE __debugPoint "" #endif @@ -1396,7 +1396,7 @@ module MapAutoOpens = static member Empty: Map<'Key, 'Value> = Map.empty -#if USE_SHIPPED_FSCORE +#if FSHARPCORE_USE_PACKAGE member x.Values = [ for KeyValue (_, v) in x -> v ] #endif diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 1be82c84895..40f8c8f8162 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -592,7 +592,7 @@ module internal MapAutoOpens = static member Empty: Map<'Key, 'Value> when 'Key: comparison -#if USE_SHIPPED_FSCORE +#if FSHARPCORE_USE_PACKAGE member Values: 'Value list #endif diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index b0e75623531..95a20226a2d 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -321,9 +321,9 @@ let buildString f = buf.ToString() /// Writing to output stream via a string buffer. -let writeViaBuffer (os: TextWriter) f x = +let writeViaBuffer (os: TextWriter) f = let buf = StringBuilder 100 - f buf x + f buf os.Write(buf.ToString()) type StringBuilder with @@ -608,4 +608,14 @@ module ArrayParallel = let inline map f (arr: 'T []) = arr |> mapi (fun _ item -> f item) + +[] +module ListParallel = + + let map f (xs: 'T list) = + xs + |> List.toArray + |> ArrayParallel.map f + |> Array.toList + \ No newline at end of file diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index 585d4a5911f..bab85ccd414 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -230,7 +230,7 @@ val equalOn: f: ('a -> 'b) -> x: 'a -> y: 'a -> bool when 'b: equality val buildString: f: (StringBuilder -> unit) -> string /// Writing to output stream via a string buffer. -val writeViaBuffer: os: TextWriter -> f: (StringBuilder -> 'a -> unit) -> x: 'a -> unit +val writeViaBuffer: os: TextWriter -> f: (StringBuilder -> unit) -> unit type StringBuilder with @@ -315,6 +315,21 @@ type DisposablesTracker = [] module ArrayParallel = + val inline iter: ('T -> unit) -> 'T[] -> unit + + val inline iteri: (int -> 'T -> unit) -> 'T[] -> unit + val inline map: ('T -> 'U) -> 'T[] -> 'U[] val inline mapi: (int -> 'T -> 'U) -> 'T[] -> 'U[] + +[] +module ListParallel = + + //val inline iter: ('T -> unit) -> 'T list -> unit + + //val inline iteri: (int -> 'T -> unit) -> 'T list -> unit + + val map: ('T -> 'U) -> 'T list -> 'U list + +//val inline mapi: (int -> 'T -> 'U) -> 'T list -> 'U list diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index d7bbdaaf68e..fcb9235f928 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -27,172 +27,11 @@ open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml -#if DEBUG -let debugPrint s = - if Internal.Utilities.Text.Parsing.Flags.debug then - printfn "\n%s" s -#else -let debugPrint s = ignore s -#endif - -let exprFromParseError (e:SynExpr) = SynExpr.FromParseError (e, e.Range) - -let patFromParseError (e:SynPat) = SynPat.FromParseError(e, e.Range) - -// record bindings returned by the recdExprBindings rule has shape: -// (binding, separator-before-this-binding) -// this function converts arguments from form -// binding1 (binding2*sep1, binding3*sep2...) sepN -// to form -// binding1*sep1, binding2*sep2 -let rebindRanges first fields lastSep = - let rec run (name, mEquals, value) l acc = - match l with - | [] -> List.rev (SynExprRecordField(name, mEquals, value, lastSep) :: acc) - | (f, m) :: xs -> run f xs (SynExprRecordField(name, mEquals, value, m) :: acc) - run first fields [] - -let mkUnderscoreRecdField m = SynLongIdent([ident("_", m)], [], [None]), false - -let mkRecdField lidwd = lidwd, true - -// Used for 'do expr' in a class. -let mkSynDoBinding (vis, expr, m) = - match vis with - | Some vis -> errorR(Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (vis.ToString()), m)) - | None -> () - SynBinding(None, - SynBindingKind.Do, - false, false, [], PreXmlDoc.Empty, SynInfo.emptySynValData, - SynPat.Const(SynConst.Unit, m), - None, expr, m, DebugPointAtBinding.NoneAtDo, - SynBindingTrivia.Zero) - -let mkSynExprDecl (e: SynExpr) = - SynModuleDecl.Expr(e, e.Range) - -let addAttribs attrs p = SynPat.Attrib(p, attrs, p.Range) - - // This function is called by the generated parser code. Returning initiates error recovery // It must be called precisely "parse_error_rich" let parse_error_rich = Some (fun (ctxt: ParseErrorContext<_>) -> errorR(SyntaxError(box ctxt, ctxt.ParseState.LexBuffer.LexemeRange))) -let unionRangeWithPos (r:range) p = - let r2 = mkRange r.FileName p p - unionRanges r r2 - -/// Report a good error at the end of file, e.g. for non-terminated strings -let checkEndOfFileError t = - match t with - | LexCont.IfDefSkip(_, _, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInHashIf()) - - | LexCont.String (_, _, LexerStringStyle.SingleQuote, kind, m) -> - if kind.IsInterpolated then - reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedString()) - else - reportParseErrorAt m (FSComp.SR.parsEofInString()) - - | LexCont.String (_, _, LexerStringStyle.TripleQuote, kind, m) -> - if kind.IsInterpolated then - reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedTripleQuoteString()) - else - reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteString()) - - | LexCont.String (_, _, LexerStringStyle.Verbatim, kind, m) -> - if kind.IsInterpolated then - reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedVerbatimString()) - else - reportParseErrorAt m (FSComp.SR.parsEofInVerbatimString()) - - | LexCont.Comment (_, _, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInComment()) - - | LexCont.SingleLineComment (_, _, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInComment()) - - | LexCont.StringInComment (_, _, LexerStringStyle.SingleQuote, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInStringInComment()) - - | LexCont.StringInComment (_, _, LexerStringStyle.Verbatim, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInVerbatimStringInComment()) - - | LexCont.StringInComment (_, _, LexerStringStyle.TripleQuote, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteStringInComment()) - - | LexCont.MLOnly (_, _, m) -> - reportParseErrorAt m (FSComp.SR.parsEofInIfOcaml()) - - | LexCont.EndLine(_, _, LexerEndlineContinuation.Skip(_, m)) -> - reportParseErrorAt m (FSComp.SR.parsEofInDirective()) - - | LexCont.EndLine(endifs, nesting, LexerEndlineContinuation.Token) - | LexCont.Token(endifs, nesting) -> - match endifs with - | [] -> () - | (_, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsNoHashEndIfFound()) - match nesting with - | [] -> () - | (_, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill()) - -type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * range - -let mkClassMemberLocalBindings(isStatic, initialRangeOpt, attrs, vis, BindingSetPreAttrs(_, isRec, isUse, declsPreAttrs, bindingSetRange)) = - let ignoredFreeAttrs, decls = declsPreAttrs attrs vis - let mWhole = - match initialRangeOpt with - | None -> bindingSetRange - | Some m -> unionRanges m bindingSetRange - // decls could have a leading attribute - |> fun m -> (m, decls) ||> unionRangeWithListBy (fun (SynBinding(range = m)) -> m) - if not (isNil ignoredFreeAttrs) then warning(Error(FSComp.SR.parsAttributesIgnored(), mWhole)); - if isUse then errorR(Error(FSComp.SR.parsUseBindingsIllegalInImplicitClassConstructors(), mWhole)) - SynMemberDefn.LetBindings (decls, isStatic, isRec, mWhole) - -let mkLocalBindings (mWhole, BindingSetPreAttrs(_, isRec, isUse, declsPreAttrs, _), mIn, body: SynExpr) = - let ignoredFreeAttrs, decls = declsPreAttrs [] None - let mWhole = - match decls with - | SynBinding(xmlDoc = xmlDoc) :: _ -> unionRangeWithXmlDoc xmlDoc mWhole - | _ -> mWhole - if not (isNil ignoredFreeAttrs) then warning(Error(FSComp.SR.parsAttributesIgnored(), mWhole)) - let mIn = - mIn - |> Option.bind (fun (mIn: range) -> - if Position.posEq mIn.Start body.Range.Start then - None - else - Some mIn) - - SynExpr.LetOrUse (isRec, isUse, decls, body, mWhole, { InKeyword = mIn }) - -let mkDefnBindings (mWhole, BindingSetPreAttrs(_, isRec, isUse, declsPreAttrs, _bindingSetRange), attrs, vis, attrsm) = - if isUse then warning(Error(FSComp.SR.parsUseBindingsIllegalInModules(), mWhole)) - let freeAttrs, decls = declsPreAttrs attrs vis - // decls might have an extended range due to leading attributes - let mWhole = (mWhole, decls) ||> unionRangeWithListBy (fun (SynBinding(range = m)) -> m) - let letDecls = [ SynModuleDecl.Let (isRec, decls, mWhole) ] - let attrDecls = if not (isNil freeAttrs) then [ SynModuleDecl.Attributes (freeAttrs, attrsm) ] else [] - attrDecls @ letDecls - -let idOfPat (parseState:IParseState) m p = - match p with - | SynPat.Wild r when parseState.LexBuffer.SupportsFeature LanguageFeature.WildCardInForLoop -> - mkSynId r "_" - | SynPat.Named (SynIdent(id,_), false, _, _) -> id - | SynPat.LongIdent(longDotId=SynLongIdent([id], _, _); typarDecls=None; argPats=SynArgPats.Pats []; accessibility=None) -> id - | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier()) - -let checkForMultipleAugmentations m a1 a2 = - if not (isNil a1) && not (isNil a2) then raiseParseErrorAt m (FSComp.SR.parsOnlyOneWithAugmentationAllowed()) - a1 @ a2 - -let rangeOfLongIdent(lid:LongIdent) = - System.Diagnostics.Debug.Assert(not lid.IsEmpty, "the parser should never produce a long-id that is the empty list") - (lid.Head.idRange, lid) ||> unionRangeWithListBy (fun id -> id.idRange) - %} // Producing these changes the lex state, e.g. string --> token, or nesting level of braces in interpolated strings @@ -606,7 +445,7 @@ interactiveExpr: { match $2 with | Some vis -> errorR(Error(FSComp.SR.parsUnexpectedVisibilityDeclaration(vis.ToString()), rhs parseState 3)) | _ -> () - let attrDecls = if not (isNil $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] in + let attrDecls = if not (isNil $1) then [ SynModuleDecl.Attributes ($1, rangeOfNonNilAttrs $1) ] else [] attrDecls @ [ mkSynExprDecl $3 ] } /* A #directive interaction in F# Interactive */ @@ -614,7 +453,6 @@ interactiveHash: | hashDirective { [SynModuleDecl.HashDirective($1, rhs parseState 1)] } - /* One or more separators between interactions in F# Interactive */ interactiveSeparators: | interactiveSeparator { } @@ -1561,18 +1399,23 @@ attributeListElements: attribute: /* A custom attribute */ | path opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType - { let arg = match $3 with None -> mkSynUnit $1.Range | Some e -> e - ({ TypeName=$1; ArgExpr=arg; Target=None; AppliesToGetterAndSetter=false; Range=$1.Range } : SynAttribute) } + { let arg = match $3 with None -> mkSynUnit $1.Range | Some e -> e + let m = unionRanges $1.Range arg.Range + ({ TypeName=$1; ArgExpr=arg; Target=None; AppliesToGetterAndSetter=false; Range=m } : SynAttribute) } /* A custom attribute with an attribute target */ | attributeTarget path opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType - { let arg = match $4 with None -> mkSynUnit $2.Range | Some e -> e - ({ TypeName=$2; ArgExpr=arg; Target=$1; AppliesToGetterAndSetter=false; Range=$2.Range } : SynAttribute) } + { let arg = match $4 with None -> mkSynUnit $2.Range | Some e -> e + let startRange = match $1 with Some (ident:Ident) -> ident.idRange | None -> $2.Range + let m = unionRanges startRange arg.Range + ({ TypeName=$2; ArgExpr=arg; Target=$1; AppliesToGetterAndSetter=false; Range=m } : SynAttribute) } /* A custom attribute with an attribute target */ | attributeTarget OBLOCKBEGIN path oblockend opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType { let arg = match $6 with None -> mkSynUnit $3.Range | Some e -> e - ({ TypeName=$3; ArgExpr=arg; Target=$1; AppliesToGetterAndSetter=false; Range=$3.Range } : SynAttribute) } + let startRange = match $1 with Some ident -> ident.idRange | None -> $3.Range + let m = unionRanges startRange arg.Range + ({ TypeName=$3; ArgExpr=arg; Target=$1; AppliesToGetterAndSetter=false; Range=m } : SynAttribute) } /* The target of a custom attribute */ @@ -1863,7 +1706,7 @@ memberCore: let xmlDoc = grabXmlDocAtRangeStart(parseState, attrs, rangeStart) let memberFlags = Some (memFlagsBuilder SynMemberKind.Member) let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) - let trivia: SynBindingTrivia = { LetKeyword = None; EqualsRange = Some mEquals } + let trivia: SynBindingTrivia = { LetKeyword = None; EqualsRange = Some mEquals; ExternKeyword = None } let binding = mkSynBinding (xmlDoc, bindingPat) (vis, $1, false, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible, optReturnType, $5, mRhs, [], attrs, memberFlags, trivia) let memberRange = unionRanges rangeStart mRhs |> unionRangeWithXmlDoc xmlDoc [ SynMemberDefn.Member (binding, memberRange) ]) } @@ -1980,7 +1823,7 @@ classDefnMember: let declPat = SynPat.LongIdent (SynLongIdent([mkSynId (rhs parseState 3) "new"], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [$4], vis, rhs parseState 3) // Check that 'SynPatForConstructorDecl' matches this correctly assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false) - let synBindingTrivia: SynBindingTrivia = { LetKeyword = None; EqualsRange = Some mEquals } + let synBindingTrivia: SynBindingTrivia = { LetKeyword = None; EqualsRange = Some mEquals; ExternKeyword = None } [ SynMemberDefn.Member(SynBinding (None, SynBindingKind.Normal, false, false, $1, xmlDoc, valSynData, declPat, None, expr, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible, synBindingTrivia), m) ] } | opt_attributes opt_declVisibility STATIC typeKeyword tyconDefn @@ -2738,7 +2581,8 @@ hardwhiteDefnBindingsTerminator: /* An 'extern' DllImport function definition in C-style syntax */ cPrototype: | EXTERN cRetType opt_access ident opt_HIGH_PRECEDENCE_APP LPAREN externArgs rparen - { let rty, vis, nm, args = $2, $3, $4, $7 + { let mExtern = rhs parseState 1 + let rty, vis, nm, args = $2, $3, $4, $7 let nmm = rhs parseState 3 let argsm = rhs parseState 6 let mBindLhs = lhs parseState @@ -2755,10 +2599,11 @@ cPrototype: let bindingPat = SynPat.LongIdent (SynLongIdent([nm], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [SynPat.Tuple(false, args, argsm)], vis, nmm) let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) let xmlDoc = grabXmlDoc(parseState, attrs, 1) + let trivia = { LetKeyword = None; ExternKeyword = Some mExtern; EqualsRange = None } let binding = mkSynBinding (xmlDoc, bindingPat) - (vis, false, false, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible, Some rty, rhsExpr, mRhs, [], attrs, None, SynBindingTrivia.Zero) + (vis, false, false, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible, Some rty, rhsExpr, mRhs, [], attrs, None, trivia) [], [binding]) } /* A list of arguments in an 'extern' DllImport function definition */ @@ -2877,7 +2722,7 @@ localBinding: let mWhole = (unionRanges mLetKwd mRhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) let spBind = if IsDebugPointBinding bindingPat expr then DebugPointAtBinding.Yes mWhole else DebugPointAtBinding.NoneAtLet let mWholeBindLhs = (mBindLhs, attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) - let trivia: SynBindingTrivia = { LetKeyword = Some mLetKwd; EqualsRange = Some mEquals } + let trivia: SynBindingTrivia = { LetKeyword = Some mLetKwd; EqualsRange = Some mEquals; ExternKeyword = None } mkSynBinding (xmlDoc, bindingPat) (vis, $1, $2, mWholeBindLhs, spBind, optReturnType, expr, mRhs, opts, attrs, None, trivia)) localBindingRange, localBindingBuilder } @@ -2892,7 +2737,7 @@ localBinding: let zeroWidthAtEnd = mEquals.EndRange let rhsExpr = arbExpr("localBinding1", zeroWidthAtEnd) let spBind = if IsDebugPointBinding bindingPat rhsExpr then DebugPointAtBinding.Yes mWhole else DebugPointAtBinding.NoneAtLet - let trivia: SynBindingTrivia = { LetKeyword = Some mLetKwd; EqualsRange = Some mEquals } + let trivia: SynBindingTrivia = { LetKeyword = Some mLetKwd; EqualsRange = Some mEquals; ExternKeyword = None } mkSynBinding (xmlDoc, bindingPat) (vis, $1, $2, mBindLhs, spBind, optReturnType, rhsExpr, mRhs, [], attrs, None, trivia)) mWhole, localBindingBuilder } @@ -2905,7 +2750,7 @@ localBinding: let localBindingBuilder = (fun xmlDoc attrs vis mLetKwd -> let spBind = DebugPointAtBinding.Yes (unionRanges mLetKwd mRhs) - let trivia = { LetKeyword = Some mLetKwd; EqualsRange = None } + let trivia = { LetKeyword = Some mLetKwd; EqualsRange = None; ExternKeyword = None } let rhsExpr = arbExpr("localBinding2", mRhs) mkSynBinding (xmlDoc, bindingPat) (vis, $1, $2, mBindLhs, spBind, optReturnType, rhsExpr, mRhs, [], attrs, None, trivia)) mWhole, localBindingBuilder } @@ -3124,10 +2969,13 @@ headBindingPattern: SynPat.Or($1, $3, rhs2 parseState 1 3, { BarRange = mBar }) } | headBindingPattern COLON_COLON headBindingPattern - { SynPat.LongIdent (SynLongIdent(mkSynCaseName (rhs parseState 2) opNameCons, [], [ Some (IdentTrivia.OriginalNotation "::") ]), None, None, SynArgPats.Pats [SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3)], None, lhs parseState) } + { let mColonColon = rhs parseState 2 + SynPat.ListCons($1, $3, rhs2 parseState 1 3, { ColonColonRange = mColonColon }) } - | tuplePatternElements %prec pat_tuple - { SynPat.Tuple(false, List.rev $1, lhs parseState) } + | tuplePatternElements %prec pat_tuple + { let pats = normalizeTuplePat $1 + let m = (rhs parseState 1, pats) ||> unionRangeWithListBy (fun p -> p.Range) + SynPat.Tuple(false, List.rev pats, m) } | conjPatternElements %prec pat_conj { SynPat.Ands(List.rev $1, lhs parseState) } @@ -3135,12 +2983,37 @@ headBindingPattern: | constrPattern { $1 } -tuplePatternElements: - | tuplePatternElements COMMA headBindingPattern +tuplePatternElements: + | tuplePatternElements COMMA headBindingPattern { $3 :: $1 } - | headBindingPattern COMMA headBindingPattern - { $3 :: $1 :: [] } + | headBindingPattern COMMA headBindingPattern + { [$3; $1] } + + | tuplePatternElements COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 2 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple ()) + let pat2 = SynPat.Wild(commaRange.EndRange) + pat2 :: $1 } + + | headBindingPattern COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 2 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple ()) + let pat2 = SynPat.Wild(commaRange.EndRange) + [pat2; $1] } + + | COMMA headBindingPattern + { let commaRange = rhs parseState 1 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple ()) + let pat1 = SynPat.Wild(commaRange.StartRange) + [$2; pat1] } + + | COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 1 + if not $2 then reportParseErrorAt commaRange (FSComp.SR.parsExpectedPatternAfterToken ()) + let pat1 = SynPat.Wild(commaRange.StartRange) + let pat2 = SynPat.Wild(commaRange.EndRange) + [pat2; pat1] } conjPatternElements: | conjPatternElements AMP headBindingPattern @@ -3210,7 +3083,10 @@ constrPattern: atomicPatsOrNamePatPairs: | LPAREN namePatPairs rparen - { SynArgPats.NamePatPairs $2, snd $2 } + { let mParen = rhs2 parseState 1 3 + let pats, m = $2 + let trivia = { ParenRange = mParen } + SynArgPats.NamePatPairs(pats, m, trivia), snd $2 } | atomicPatterns { let mParsed = rhs parseState 1 @@ -3351,8 +3227,10 @@ parenPattern: { let mBar = rhs parseState 2 SynPat.Or($1, $3, rhs2 parseState 1 3, { BarRange = mBar }) } - | tupleParenPatternElements - { SynPat.Tuple(false, List.rev $1, lhs parseState) } + | tupleParenPatternElements + { let pats = normalizeTuplePat $1 + let m = (rhs parseState 1, pats) ||> unionRangeWithListBy (fun p -> p.Range) + SynPat.Tuple(false, List.rev pats, m) } | conjParenPatternElements { SynPat.Ands(List.rev $1, rhs2 parseState 1 3) } @@ -3366,16 +3244,42 @@ parenPattern: SynPat.Attrib($2, $1, mLhs) } | parenPattern COLON_COLON parenPattern - { SynPat.LongIdent (SynLongIdent(mkSynCaseName (rhs parseState 2) opNameCons, [], [ Some (IdentTrivia.OriginalNotation "::") ]), None, None, SynArgPats.Pats [ SynPat.Tuple (false, [$1;$3], rhs2 parseState 1 3) ], None, lhs parseState) } + { let mColonColon = rhs parseState 2 + SynPat.ListCons($1, $3, rhs2 parseState 1 3, { ColonColonRange = mColonColon }) } | constrPattern { $1 } tupleParenPatternElements: - | tupleParenPatternElements COMMA parenPattern + | tupleParenPatternElements COMMA parenPattern { $3 :: $1 } - | parenPattern COMMA parenPattern - { $3 :: $1 :: [] } + | parenPattern COMMA parenPattern + { [$3; $1] } + + | tupleParenPatternElements COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 2 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple()) + let pat2 = SynPat.Wild(commaRange.EndRange) + pat2 :: $1 } + + | parenPattern COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 2 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple()) + let pat2 = SynPat.Wild(commaRange.EndRange) + [pat2; $1] } + + | COMMA parenPattern + { let commaRange = rhs parseState 1 + reportParseErrorAt commaRange (FSComp.SR.parsExpectingPatternInTuple()) + let pat1 = SynPat.Wild(commaRange.StartRange) + [$2; pat1] } + + | COMMA ends_coming_soon_or_recover + { let commaRange = rhs parseState 1 + if not $2 then reportParseErrorAt commaRange (FSComp.SR.parsExpectedPatternAfterToken ()) + let pat1 = SynPat.Wild(commaRange.StartRange) + let pat2 = SynPat.Wild(commaRange.EndRange) + [pat2; pat1] } conjParenPatternElements: | conjParenPatternElements AMP parenPattern @@ -5207,15 +5111,99 @@ arrayTypeSuffix: | LBRACK RBRACK { 1 } - | LBRACK COMMA RBRACK + | LBRACK COMMA RBRACK { 2 } - | LBRACK COMMA COMMA RBRACK + | LBRACK COMMA COMMA RBRACK { 3 } - | LBRACK COMMA COMMA COMMA RBRACK + | LBRACK COMMA COMMA COMMA RBRACK { 4 } + | LBRACK COMMA COMMA COMMA COMMA RBRACK + { 5 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA RBRACK + { 6 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 7 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 8 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 9 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 10 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 11 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 12 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 13 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 14 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 15 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 16 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 17 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 18 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 19 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 20 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 21 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 22 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 23 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 24 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 25 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 26 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 27 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 28 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 29 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 30 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 31 } + + | LBRACK COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA COMMA RBRACK + { 32 } + appTypePrefixArguments: | typeArgActual COMMA typeArgActual typeArgListElements { let typeArgs, commas = $4 in $1 :: $3 :: List.rev typeArgs, (rhs parseState 2) :: (List.rev commas) } diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 8a1853a380f..1d56df844c3 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -592,6 +592,16 @@ Neočekávaný token v definici typu. Za typem {0} se očekává =. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Sestavení {0} se nedalo přeložit. - - Could not resolve assembly '{0}' required by '{1}' - Sestavení {0} požadované souborem {1} se nedalo přeložit. - - Error opening binary file '{0}': {1} Chyba při otevírání binárního souboru {0}: {1} @@ -2257,11 +2262,6 @@ Hodnoty base se dají použít jenom k přímému volání implementací base přepsaných členů. - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Konstruktory objektu nemůžou použít try/with a try/finally přímo, dokud se objekt neinicializuje. To zahrnuje i konstrukce, jako je třeba for x in ..., které se dají na použití těchto konstruktorů rozpracovat. Toto je omezení mezijazyka Common IL. - - The address of the variable '{0}' cannot be used at this point Adresa proměnné {0} se na tomto místě použít nedá. @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Tento případ typu union očekává argumenty v počtu {0} v podobě řazené kolekce členů. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index e96c8e1d3b2..0756782570b 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -592,6 +592,16 @@ Unerwartetes Token in Typdefinition. Nach Typ "{0}" wurde "=" erwartet. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Assembly "{0}" konnte nicht aufgelöst werden. - - Could not resolve assembly '{0}' required by '{1}' - Die für "{1}" erforderliche Assembly "{0}" konnte nicht aufgelöst werden. - - Error opening binary file '{0}': {1} Fehler beim Öffnen der Binärdatei "{0}": {1} @@ -2257,11 +2262,6 @@ base-Werte dürfen nur für direkte Aufrufe der Basisimplementierungen von überschriebenen Membern verwendet werden. - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Objektkonstruktoren dürfen "try/with" und "try/finally" vor der Initialisierung des Objekts nicht direkt verwenden. Dies umfasst Konstrukte wie "for x in ...", bei denen diese Konstrukte u.U. verwendet werden. Dies ist eine Einschränkung der Common IL. - - The address of the variable '{0}' cannot be used at this point Die Adresse der Variablen "{0}" kann an diesem Punkt nicht verwendet werden. @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Dieser Union-Fall erwartet {0} Argumente als Tupel. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 8c034062331..b627eaf2315 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -592,6 +592,16 @@ Token inesperado en la definición de tipo. Se esperaba "=" después del tipo "{0}". + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ No se pudo resolver el ensamblado '{0}'. - - Could not resolve assembly '{0}' required by '{1}' - No se pudo resolver el ensamblado '{0}' requerido por '{1}'. - - Error opening binary file '{0}': {1} Error al abrir el archivo binario '{0}': {1}. @@ -2257,11 +2262,6 @@ Los valores 'base' se pueden usar solo para realizar llamadas directas a las implementaciones base de miembros invalidados. - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Los constructores de objetos no pueden usar directamente try/with y try/finally antes de la inicialización del objeto. Esto incluye constructores como 'for x in ...' que pueden dar lugar a usos de estos constructores. Esta es una limitación impuesta por Common IL. - - The address of the variable '{0}' cannot be used at this point La dirección de la variable '{0}' no se puede usar en este punto. @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Este caso de unión espera {0} argumentos en forma de tupla. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index ab6345e8e0c..8ff78e1d343 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -592,6 +592,16 @@ Jeton inattendu dans la définition de type. Signe '=' attendu après le type '{0}'. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Impossible de résoudre l'assembly '{0}' - - Could not resolve assembly '{0}' required by '{1}' - Impossible de résoudre l'assembly '{0}' requis par '{1}' - - Error opening binary file '{0}': {1} Erreur lors de l'ouverture du fichier binaire '{0}' : {1} @@ -2257,11 +2262,6 @@ Les valeurs 'base' ne peuvent être utilisées que pour effectuer des appels directs aux implémentations de base des membres substitués - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Les constructeurs d'objets ne peuvent pas utiliser directement try/with et try/finally avant l'initialisation de l'objet. Cela inclut les constructions telles que 'for x in ...' qui peuvent conduire aux utilisations de ces constructions. Il s'agit d'une limitation imposée par le langage CIL (Common Intermediate Language). - - The address of the variable '{0}' cannot be used at this point Impossible d'utiliser l'adresse de la variable '{0}' actuellement @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Ce cas d'union attend {0} arguments basés sur des tuples + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 85a4a4cd333..4f1344f084c 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -592,6 +592,16 @@ Token imprevisto nella definizione del tipo. Dopo il tipo '{0}' è previsto '='. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Non è stato possibile risolvere l'assembly '{0}' - - Could not resolve assembly '{0}' required by '{1}' - Non è stato possibile risolvere l'assembly '{0}' richiesto da '{1}' - - Error opening binary file '{0}': {1} Errore durante l'apertura del file binario '{0}': {1} @@ -2257,11 +2262,6 @@ I valori 'base' possono essere utilizzati esclusivamente per effettuare chiamate dirette alle implementazioni di base dei membri sottoposti a override - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - I costruttori di oggetti non possono utilizzare direttamente try/with e try/finally prima dell'inizializzazione dell'oggetto. Ciò include costrutti quali 'for x in ...' che potrebbero essere elaborati negli utilizzi di tali costrutti. Si tratta di una limitazione imposta dall'IL comune. - - The address of the variable '{0}' cannot be used at this point Non è possibile usare l'indirizzo della variabile '{0}' in questo punto @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Questo case di unione prevede {0} argomenti sotto forma di tupla + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 1a49a44350e..3be4cc87996 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -592,6 +592,16 @@ 型定義に予期しないトークンがあります。型 '{0}' の後には '=' が必要です。 + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ アセンブリ '{0}' を解決できませんでした - - Could not resolve assembly '{0}' required by '{1}' - {1}' に必要なアセンブリ '{0}' を解決できませんでした - - Error opening binary file '{0}': {1} バイナリ ファイル '{0}' を開くときにエラーが発生しました: {1} @@ -2257,11 +2262,6 @@ 'base' 値を使用できるのは、オーバーライドされたメンバーの基本実装に対して直接呼び出しを行う場合のみです。 - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - オブジェクト コンストラクターでは、オブジェクトの初期化前に try/with および try/finally を直接使用できません。'for x in ...' などのコストラクトを呼び出す可能性があるようなコンストラクトがこれに含まれます。これは Common IL での制限事項です。 - - The address of the variable '{0}' cannot be used at this point この時点で変数 '{0}' のアドレスは使用できません @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - この共用体ケースにはタプル形式の引数を {0} 個指定してください + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 1a4cb6964d8..728c94688d2 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -592,6 +592,16 @@ 형식 정의에 예기치 않은 토큰이 있습니다. '{0}' 형식 뒤에 '='가 필요합니다. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ '{0}' 어셈블리를 확인할 수 없습니다. - - Could not resolve assembly '{0}' required by '{1}' - {1}'에 필요한 '{0}' 어셈블리를 확인할 수 없습니다. - - Error opening binary file '{0}': {1} 이진 파일 '{0}'을(를) 여는 동안 오류가 발생했습니다. {1} @@ -2257,11 +2262,6 @@ 'base' 값은 재정의된 멤버의 기본 구현에 대한 직접 호출을 수행하는 데에만 사용할 수 있습니다. - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - 개체 생성자는 개체 초기화 전에 try/with 및 try/finally를 직접 사용할 수 없습니다. 여기에는 이러한 구문의 사용을 자세히 설명할 수 있는 'for x in ...'과 같은 구문이 포함됩니다. 이는 공통 IL의 제한입니다. - - The address of the variable '{0}' cannot be used at this point '{0}' 변수의 주소를 현재 사용할 수 없습니다. @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - 이 공용 구조체 케이스에는 튜플된 형식의 인수 {0}개가 필요합니다. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 1cc8dfb88f1..284aef3e014 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -592,6 +592,16 @@ Nieoczekiwany token w definicji typu. Oczekiwano znaku „=” po typie „{0}”. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Nie można rozpoznać zestawu „{0}” - - Could not resolve assembly '{0}' required by '{1}' - Nie można rozpoznać zestawu „{0}” wymaganego przez „{1}” - - Error opening binary file '{0}': {1} Błąd podczas otwierania pliku binarnego „{0}”: {1} @@ -2257,11 +2262,6 @@ Wartości „base” mogą być używane tylko w celu bezpośrednich wywołań, które dotyczą podstawowych implementacji przesłoniętych elementów członkowskich - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Konstruktory obiektów nie mogą bezpośrednio używać instrukcji try/with i try/finally przed zainicjowaniem obiektu. Obejmuje to takie konstrukcje, jak „for x in ...”, które mogą skutkować użyciem takich konstrukcji. Jest to ograniczenie nałożone przez język Common IL. - - The address of the variable '{0}' cannot be used at this point Nie można użyć adresu zmiennej „{0}” w tym momencie @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Ten przypadek unii oczekuje {0} argumentów w postaci spójnej kolekcji + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 1c898a6234e..a5b2b954366 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -592,6 +592,16 @@ Token inesperado na definição de tipo. Esperava-se '=' após o tipo '{0}'. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Não foi possível resolver o assembly '{0}' - - Could not resolve assembly '{0}' required by '{1}' - Não foi possível resolver o assembly '{0}' requerido por '{1}' - - Error opening binary file '{0}': {1} Erro ao abrir o arquivo binário '{0}': {1} @@ -2257,11 +2262,6 @@ Valores 'base' só podem ser usados para fazer chamadas diretas às implementações de base de membros substituídos - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Construtores de objeto não podem usar try/with nem try/finally antes da inicialização do objeto. O que inclui construções como ' x in... ' que podem elaborar usos dessas construções. Esta é uma limitação imposta pelo IL Comum. - - The address of the variable '{0}' cannot be used at this point O endereço da variável '{0}' não pode ser usado neste ponto @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Este caso união espera argumentos {0} na forma de tupla + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index b9094d89e3f..545decc4361 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -592,6 +592,16 @@ Неожиданный токен в определении типа. После типа "{0}" ожидается "=". + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ Не удалось разрешить сборку "{0}". - - Could not resolve assembly '{0}' required by '{1}' - Не удалось разрешить сборку "{0}", необходимую для "{1}" - - Error opening binary file '{0}': {1} Ошибка при открытии двоичного файла "{0}": {1} @@ -2257,11 +2262,6 @@ Значения "base" можно использовать только для выполнения прямых вызовов реализаций класса base для переопределенных элементов - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - В конструкторе объекта нельзя прямо использовать блоки try/with и try/finally до инициализации объекта. К таким вариантам использования также относятся и конструкции вида "for x in ...", применение которых может привести к использованию указанных конструкций. Это ограничение связано с требованиями общего промежуточного языка. - - The address of the variable '{0}' cannot be used at this point В этой точке нельзя использовать адрес переменной "{0}" @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Для данного случая объединения требуется {0} аргументов в форме кортежа + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 7ee5a8cb3bc..1c0cfc90425 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -592,6 +592,16 @@ Tür tanımında beklenmeyen belirteç var. '{0}' türünden sonra '=' bekleniyordu. + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ '{0}' bütünleştirilmiş kodu çözümlenemedi - - Could not resolve assembly '{0}' required by '{1}' - {1}' tarafından istenen '{0}' bütünleştirilmiş kodu çözümlenemedi - - Error opening binary file '{0}': {1} {0}': {1} ikili dosyasını açma işleminde hata @@ -2257,11 +2262,6 @@ 'base' değerleri yalnızca geçersiz kılınmış üyelerin taban uygulamalarına doğrudan çağrı yapmak için kullanılabilir - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - Nesne oluşturucular, nesnenin başlatılmasından önce try/with ve try/finally ifadelerini doğrudan kullanamazlar. Buna bu yapıların kullanımını çeşitlendirebilen 'for x in ...' gibi yapılar da dahildir. Bu, Ortak Ara Dilin getirdiği bir kısıtlamadır. - - The address of the variable '{0}' cannot be used at this point '{0}' değişkeninin adresi bu noktada kullanılamaz @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - Bu birleşim durumu grup olarak tanımlanmış biçimde {0} bağımsız değişken bekliyor + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 2659f03165a..bf7eeca1f77 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -592,6 +592,16 @@ 类型定义中出现意外标记。类型“{0}”后应为 "="。 + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ 无法解析程序集“{0}” - - Could not resolve assembly '{0}' required by '{1}' - 无法解析“{1}”所需的程序集“{0}” - - Error opening binary file '{0}': {1} 打开二进制文件“{0}”时出错: {1} @@ -2257,11 +2262,6 @@ "base" 值只能用于直接调用重写成员的基实现 - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - 在初始化对象之前，对象构造函数不能直接使用 try/with 和 try/finally。这包括像 "for x in ..." 这样详细说明其构造使用方式的构造。这是由通用 IL 设定的限制。 - - The address of the variable '{0}' cannot be used at this point 此时无法使用变量“{0}”的地址 @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - 此联合用例需要 {0} 个元组格式的参数 + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index f7f06f543fc..f2d4f429c8f 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -592,6 +592,16 @@ 型別定義中出現非預期的權杖。類型 '{0}' 之後應該要有 '='。 + + Expected a pattern after this point + Expected a pattern after this point + + + + Expecting pattern + Expecting pattern + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -1307,11 +1317,6 @@ 無法解析組件 '{0}' - - Could not resolve assembly '{0}' required by '{1}' - 無法解析 '{1}' 所需的組件 '{0}' - - Error opening binary file '{0}': {1} 開啟二進位檔案 '{0}' 時發生錯誤: {1} @@ -2257,11 +2262,6 @@ 'base' 值只能用來直接呼叫覆寫成員的基底實作 - - Object constructors cannot directly use try/with and try/finally prior to the initialization of the object. This includes constructs such as 'for x in ...' that may elaborate to uses of these constructs. This is a limitation imposed by Common IL. - 物件建構函式不能在物件初始化之前直接使用 try/with 和 try/finally。這包括 'for x in ...' 這類可以詳述這些建構用途的建構函式。這是 Common IL 的限制。 - - The address of the variable '{0}' cannot be used at this point 目前無法使用變數 '{0}' 的位址 @@ -3788,8 +3788,8 @@ - This union case expects {0} arguments in tupled form - 這個聯集需要 {0} 個 Tuple 形式的引數 + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Directory.Build.props b/src/Directory.Build.props index 5950a28ad0f..68eba530bc9 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -2,15 +2,6 @@ - - - true - - true false diff --git a/src/FSharp.Core/async.fsi b/src/FSharp.Core/async.fsi index a26c09b2156..3aa0403bb19 100644 --- a/src/FSharp.Core/async.fsi +++ b/src/FSharp.Core/async.fsi @@ -51,7 +51,7 @@ namespace Microsoft.FSharp.Control /// /// If an exception occurs in the asynchronous computation then an exception is re-raised by this /// function. - /// + /// /// If no cancellation token is provided then the default cancellation token is used. /// /// The computation is started on the current thread if is null, @@ -73,8 +73,22 @@ namespace Microsoft.FSharp.Control /// The result of the computation. /// /// Starting Async Computations - /// - /// + /// + /// + /// + /// printfn "A" + /// + /// let result = async { + /// printfn "B" + /// do! Async.Sleep(1000) + /// printfn "C" + /// 17 + /// } |> Async.RunSynchronously + /// + /// printfn "D" + /// + /// Prints "A", "B" immediately, then "C", "D" in 1 second. result is set to 17. + /// static member RunSynchronously : computation:Async<'T> * ?timeout : int * ?cancellationToken:CancellationToken-> 'T /// Starts the asynchronous computation in the thread pool. Do not await its result. @@ -86,7 +100,21 @@ namespace Microsoft.FSharp.Control /// If one is not supplied, the default cancellation token is used. /// /// Starting Async Computations - /// + /// + /// + /// + /// printfn "A" + /// + /// async { + /// printfn "B" + /// do! Async.Sleep(1000) + /// printfn "C" + /// } |> Async.Start + /// + /// printfn "D" + /// + /// Prints "A", then "D", "B" quickly in any order, and then "C" in 1 second. + /// /// static member Start : computation:Async * ?cancellationToken:CancellationToken -> unit @@ -98,14 +126,30 @@ namespace Microsoft.FSharp.Control /// in the corresponding state once the computation terminates (produces the result, throws exception or gets canceled) /// /// Starting Async Computations - /// - /// + /// + /// + /// + /// printfn "A" + /// + /// let t = + /// async { + /// printfn "B" + /// do! Async.Sleep(1000) + /// printfn "C" + /// } |> Async.StartAsTask + /// + /// printfn "D" + /// t.Wait() + /// printfn "E" + /// + /// Prints "A", then "D", "B" quickly in any order, then "C", "E" in 1 second. + /// static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T> /// Creates an asynchronous computation which starts the given computation as a /// /// Starting Async Computations - /// + /// /// static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async> @@ -119,8 +163,23 @@ namespace Microsoft.FSharp.Control /// A computation that returns a choice of type T or exception. /// /// Cancellation and Exceptions + /// + /// + /// + /// let someRiskyBusiness() = + /// match DateTime.Today with + /// | dt when dt.DayOfWeek = DayOfWeek.Monday -> failwith "Not compatible with Mondays" + /// | dt -> dt /// - /// + /// async { return someRiskyBusiness() } + /// |> Async.Catch + /// |> Async.RunSynchronously + /// |> function + /// | Choice1Of2 result -> printfn $"Result: {result}" + /// | Choice2Of2 e -> printfn $"Exception: {e}" + /// + /// Prints the returned value of someRiskyBusiness() or the exception if there is one. + /// static member Catch : computation:Async<'T> -> Async> /// Creates an asynchronous computation that executes computation. @@ -134,8 +193,26 @@ namespace Microsoft.FSharp.Control /// is cancelled. /// /// Cancellation and Exceptions - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 11 ] + /// for i in primes do + /// Async.TryCancelled( + /// async { + /// do! Async.Sleep(i * 1000) + /// printfn $"{i}" + /// }, + /// fun oce -> printfn $"Computation Cancelled: {i}") + /// |> Async.Start + /// + /// Thread.Sleep(6000) + /// Async.CancelDefaultToken() + /// printfn "Tasks Finished" + /// + /// This will print "2" 2 seconds from start, "3" 3 seconds from start, "5" 5 seconds from start, cease computation + /// and then print "Computation Cancelled: 7", "Computation Cancelled: 11" and "Tasks Finished" in any order. + /// static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T> /// Generates a scoped, cooperative cancellation handler for use within an asynchronous workflow. @@ -155,8 +232,25 @@ namespace Microsoft.FSharp.Control /// before being disposed. /// /// Cancellation and Exceptions - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 11 ] + /// for i in primes do + /// async { + /// use! holder = Async.OnCancel(fun () -> printfn $"Computation Cancelled: {i}") + /// do! Async.Sleep(i * 1000) + /// printfn $"{i}" + /// } + /// |> Async.Start + /// + /// Thread.Sleep(6000) + /// Async.CancelDefaultToken() + /// printfn "Tasks Finished" + /// + /// This will print "2" 2 seconds from start, "3" 3 seconds from start, "5" 5 seconds from start, cease computation + /// and then print "Computation Cancelled: 7", "Computation Cancelled: 11" and "Tasks Finished" in any order. + /// static member OnCancel : interruption: (unit -> unit) -> Async /// Creates an asynchronous computation that returns the CancellationToken governing the execution @@ -169,7 +263,7 @@ namespace Microsoft.FSharp.Control /// expression. /// /// Cancellation and Exceptions - /// + /// /// static member CancellationToken : Async @@ -179,8 +273,32 @@ namespace Microsoft.FSharp.Control /// specific CancellationToken. /// /// Cancellation and Exceptions - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 11 ] + /// + /// let computations = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(i * 1000) + /// printfn $"{i}" + /// } + /// ] + /// + /// try + /// let t = + /// Async.Parallel(computations, 3) |> Async.StartAsTask + /// + /// Thread.Sleep(6000) + /// Async.CancelDefaultToken() + /// printfn $"Tasks Finished: %A{t.Result}" + /// with + /// | :? System.AggregateException as ae -> printfn $"Tasks Not Finished: {ae.Message}" + /// + /// This will print "2" 2 seconds from start, "3" 3 seconds from start, "5" 5 seconds from start, cease computation and + /// then print "Tasks Not Finished: One or more errors occurred. (A task was canceled.)". + /// static member CancelDefaultToken : unit -> unit /// Gets the default cancellation token for executing asynchronous computations. @@ -188,27 +306,45 @@ namespace Microsoft.FSharp.Control /// The default CancellationToken. /// /// Cancellation and Exceptions - /// - /// + /// + /// + /// + /// Async.DefaultCancellationToken.Register(fun () -> printfn "Computation Cancelled") |> ignore + /// let primes = [ 2; 3; 5; 7; 11 ] + /// + /// for i in primes do + /// async { + /// do! Async.Sleep(i * 1000) + /// printfn $"{i}" + /// } + /// |> Async.Start + /// + /// Thread.Sleep(6000) + /// Async.CancelDefaultToken() + /// printfn "Tasks Finished" + /// + /// This will print "2" 2 seconds from start, "3" 3 seconds from start, "5" 5 seconds from start, cease computation and then + /// print "Computation Cancelled", followed by "Tasks Finished". + /// static member DefaultCancellationToken : CancellationToken //---------- Parallelism /// Starts a child computation within an asynchronous workflow. /// This allows multiple asynchronous computations to be executed simultaneously. - /// + /// /// This method should normally be used as the immediate /// right-hand-side of a let! binding in an F# asynchronous workflow, that is, /// - /// async { ... - /// let! completor1 = childComputation1 |> Async.StartChild - /// let! completor2 = childComputation2 |> Async.StartChild - /// ... - /// let! result1 = completor1 - /// let! result2 = completor2 - /// ... } + /// async { ... + /// let! completor1 = childComputation1 |> Async.StartChild + /// let! completor2 = childComputation2 |> Async.StartChild + /// ... + /// let! result1 = completor1 + /// let! result2 = completor2 + /// ... } /// - /// + /// /// When used in this way, each use of StartChild starts an instance of childComputation /// and returns a completor object representing a computation to wait for the completion of the operation. /// When executed, the completor awaits the completion of childComputation. @@ -220,15 +356,42 @@ namespace Microsoft.FSharp.Control /// A new computation that waits for the input computation to finish. /// /// Cancellation and Exceptions - /// - /// + /// + /// + /// + /// + /// let computeWithTimeout timeout = + /// async { + /// let! completor1 = + /// Async.StartChild( + /// (async { + /// do! Async.Sleep(1000) + /// return 1 + /// }), + /// millisecondsTimeout = timeout) + /// + /// let! completor2 = + /// Async.StartChild( + /// (async { + /// do! Async.Sleep(2000) + /// return 2 + /// }), + /// millisecondsTimeout = timeout) + /// + /// let! v1 = completor1 + /// let! v2 = completor2 + /// printfn $"Result: {v1 + v2}" + /// } |> Async.RunSynchronously + /// + /// Will throw a System.TimeoutException if called with a timeout less than 2000, otherwise will print "Result: 3". + /// static member StartChild : computation:Async<'T> * ?millisecondsTimeout : int -> Async> /// Creates an asynchronous computation that executes all the given asynchronous computations, /// initially queueing each as work items and using a fork/join pattern. /// /// If all child computations succeed, an array of results is passed to the success continuation. - /// + /// /// If any child computation raises an exception, then the overall computation will trigger an /// exception, and cancel the others. /// @@ -241,8 +404,30 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. /// /// Composing Async Computations - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 10; 11 ] + /// let t = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(System.Random().Next(1000, 2000)) + /// + /// if i % 2 > 0 then + /// printfn $"{i}" + /// return true + /// else + /// return false + /// } + /// ] + /// |> Async.Parallel + /// |> Async.StartAsTask + /// + /// t.Wait() + /// printfn $"%A{t.Result}" + /// + /// This will print "3", "5", "7", "11" (in any order) in 1-2 seconds and then [| false; true; true; true; false; true |]. + /// static member Parallel : computations:seq> -> Async<'T[]> /// Creates an asynchronous computation that executes all the given asynchronous computations, @@ -263,8 +448,33 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. /// /// Composing Async Computations - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 10; 11 ] + /// let computations = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(System.Random().Next(1000, 2000)) + /// + /// return + /// if i % 2 > 0 then + /// printfn $"{i}" + /// true + /// else + /// false + /// } ] + /// + /// let t = + /// Async.Parallel(computations, maxDegreeOfParallelism=3) + /// |> Async.StartAsTask + /// + /// t.Wait() + /// printfn $"%A{t.Result}" + /// + /// This will print "3", "5" (in any order) in 1-2 seconds, and then "7", "11" (in any order) in 1-2 more seconds and then + /// [| false; true; true; true; false; true |]. + /// static member Parallel : computations:seq> * ?maxDegreeOfParallelism : int -> Async<'T[]> /// Creates an asynchronous computation that executes all the given asynchronous computations sequentially. @@ -283,13 +493,40 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. /// /// Composing Async Computations - /// - /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7; 10; 11 ] + /// let computations = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(System.Random().Next(1000, 2000)) + /// + /// if i % 2 > 0 then + /// printfn $"{i}" + /// return true + /// else + /// return false + /// } + /// ] + /// + /// let t = + /// Async.Sequential(computations) + /// |> Async.StartAsTask + /// + /// t.Wait() + /// printfn $"%A{t.Result}" + /// + /// This will print "3", "5", "7", "11" with ~1-2 seconds between them except for pauses where even numbers would be and then + /// prints [| false; true; true; true; false; true |]. + /// static member Sequential : computations:seq> -> Async<'T[]> - /// Creates an asynchronous computation that executes all given asynchronous computations in parallel, + /// + /// Creates an asynchronous computation that executes all given asynchronous computations in parallel, /// returning the result of the first succeeding computation (one whose result is 'Some x'). - /// If all child computations complete with None, the parent computation also returns None. + /// If all child computations complete with None, the parent computation also returns None. + /// /// /// /// If any child computation raises an exception, then the overall computation will trigger an @@ -297,15 +534,63 @@ namespace Microsoft.FSharp.Control /// /// The overall computation will respond to cancellation while executing the child computations. /// If cancelled, the computation will cancel any remaining child computations but will still wait - /// for the other child computations to complete. + /// for the other child computations to complete. + /// /// /// A sequence of computations to be parallelized. /// /// A computation that returns the first succeeding computation. /// /// Composing Async Computations - /// - /// + /// + /// + /// + /// printfn "Starting" + /// let primes = [ 2; 3; 5; 7 ] + /// let computations = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(System.Random().Next(1000, 2000)) + /// return if i % 2 > 0 then Some(i) else None + /// } + /// ] + /// + /// computations + /// |> Async.Choice + /// |> Async.RunSynchronously + /// |> function + /// | Some (i) -> printfn $"{i}" + /// | None -> printfn "No Result" + /// + /// Prints one randomly selected odd number in 1-2 seconds. If the list is changed to all even numbers, it will + /// instead print "No Result". + /// + /// + /// + /// + /// let primes = [ 2; 3; 5; 7 ] + /// let computations = + /// [ for i in primes do + /// async { + /// do! Async.Sleep(System.Random().Next(1000, 2000)) + /// + /// return + /// if i % 2 > 0 then + /// Some(i) + /// else + /// failwith $"Even numbers not supported: {i}" + /// } + /// ] + /// + /// computations + /// |> Async.Choice + /// |> Async.RunSynchronously + /// |> function + /// | Some (i) -> printfn $"{i}" + /// | None -> printfn "No Result" + /// + /// Will sometimes print one randomly selected odd number, sometimes throw System.Exception("Even numbers not supported: 2"). + /// static member Choice : computations:seq> -> Async<'T option> //---------- Thread Control @@ -316,8 +601,16 @@ namespace Microsoft.FSharp.Control /// A computation that will execute on a new thread. /// /// Threads and Contexts - /// - /// + /// + /// + /// + /// async { + /// do! Async.SwitchToNewThread() + /// do! someLongRunningComputation() + /// } |> Async.StartImmediate + /// + /// This will run someLongRunningComputation() without blocking the threads in the threadpool. + /// static member SwitchToNewThread : unit -> Async /// Creates an asynchronous computation that queues a work item that runs @@ -326,8 +619,21 @@ namespace Microsoft.FSharp.Control /// A computation that generates a new work item in the thread pool. /// /// Threads and Contexts - /// - /// + /// + /// + /// + /// async { + /// do! Async.SwitchToNewThread() + /// do! someLongRunningComputation() + /// do! Async.SwitchToThreadPool() + /// + /// for i in 1 .. 10 do + /// do! someShortRunningComputation() + /// } |> Async.StartImmediate + /// + /// This will run someLongRunningComputation() without blocking the threads in the threadpool, and then switch to the + /// threadpool for shorter computations. + /// static member SwitchToThreadPool : unit -> Async /// Creates an asynchronous computation that runs @@ -339,7 +645,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that uses the syncContext context to execute. /// /// Threads and Contexts - /// + /// /// static member SwitchToContext : syncContext:System.Threading.SynchronizationContext -> Async @@ -353,8 +659,33 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that provides the callback with the current continuations. /// /// Composing Async Computations + /// + /// + /// + /// let someRiskyBusiness() = + /// match DateTime.Today with + /// | dt when dt.DayOfWeek = DayOfWeek.Monday -> failwith "Not compatible with Mondays" + /// | dt -> dt /// - /// + /// let computation = + /// (fun (successCont, exceptionCont, cancellationCont) -> + /// try + /// someRiskyBusiness () |> successCont + /// with + /// | :? OperationCanceledException as oce -> cancellationCont oce + /// | e -> exceptionCont e) + /// |> Async.FromContinuations + /// + /// Async.StartWithContinuations( + /// computation, + /// (fun result -> printfn $"Result: {result}"), + /// (fun e -> printfn $"Exception: {e}"), + /// (fun oce -> printfn $"Cancelled: {oce}") + /// ) + /// + /// This anonymous function will call someRiskyBusiness() and properly use the provided continuations + /// defined to report the outcome. + /// static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T> /// Creates an asynchronous computation that waits for a single invocation of a CLI @@ -364,7 +695,7 @@ namespace Microsoft.FSharp.Control /// The computation will respond to cancellation while waiting for the event. If a /// cancellation occurs, and cancelAction is specified, then it is executed, and /// the computation continues to wait for the event. - /// + /// /// If cancelAction is not specified, then cancellation causes the computation /// to cancel immediately. /// @@ -375,7 +706,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that waits for the event to be invoked. /// /// Awaiting Results - /// + /// /// static member AwaitEvent: event:IEvent<'Del,'T> * ?cancelAction : (unit -> unit) -> Async<'T> when 'Del : delegate<'T,unit> and 'Del :> System.Delegate @@ -390,7 +721,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that waits on the given WaitHandle. /// /// Awaiting Results - /// + /// /// static member AwaitWaitHandle: waitHandle: WaitHandle * ?millisecondsTimeout:int -> Async @@ -405,7 +736,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that waits on the given IAsyncResult. /// /// Awaiting Results - /// + /// /// static member AwaitIAsyncResult: iar: System.IAsyncResult * ?millisecondsTimeout:int -> Async @@ -416,7 +747,7 @@ namespace Microsoft.FSharp.Control /// /// If an exception occurs in the asynchronous computation then an exception is re-raised by this /// function. - /// + /// /// If the task is cancelled then is raised. Note /// that the task may be governed by a different cancellation token to the overall async computation /// where the AwaitTask occurs. In practice you should normally start the task with the @@ -426,7 +757,7 @@ namespace Microsoft.FSharp.Control /// /// /// Awaiting Results - /// + /// /// static member AwaitTask: task: Task<'T> -> Async<'T> @@ -437,7 +768,7 @@ namespace Microsoft.FSharp.Control /// /// If an exception occurs in the asynchronous computation then an exception is re-raised by this /// function. - /// + /// /// If the task is cancelled then is raised. Note /// that the task may be governed by a different cancellation token to the overall async computation /// where the AwaitTask occurs. In practice you should normally start the task with the @@ -447,7 +778,7 @@ namespace Microsoft.FSharp.Control /// /// /// Awaiting Results - /// + /// /// static member AwaitTask: task: Task -> Async @@ -465,8 +796,19 @@ namespace Microsoft.FSharp.Control /// and not infinite. /// /// Awaiting Results - /// - /// + /// + /// + /// + /// async { + /// printfn "A" + /// do! Async.Sleep(1000) + /// printfn "B" + /// } |> Async.Start + /// + /// printfn "C" + /// + /// Prints "C", then "A" quickly, and then "B" 1 second later + /// static member Sleep: millisecondsDueTime:int -> Async /// @@ -482,8 +824,18 @@ namespace Microsoft.FSharp.Control /// Thrown when the due time is negative. /// /// Awaiting Results - /// - /// + /// + /// + /// + /// async { + /// printfn "A" + /// do! Async.Sleep(TimeSpan(0, 0, 1)) + /// printfn "B" + /// } |> Async.Start + /// printfn "C" + /// + /// Prints "C", then "A" quickly, and then "B" 1 second later. + /// static member Sleep: dueTime:TimeSpan -> Async /// @@ -495,7 +847,7 @@ namespace Microsoft.FSharp.Control /// The computation will respond to cancellation while waiting for the completion /// of the operation. If a cancellation occurs, and cancelAction is specified, then it is /// executed, and the computation continues to wait for the completion of the operation. - /// + /// /// If cancelAction is not specified, then cancellation causes the computation /// to stop immediately, and subsequent invocations of the callback are ignored. /// @@ -506,7 +858,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation wrapping the given Begin/End functions. /// /// Legacy .NET Async Interoperability - /// + /// /// static member FromBeginEnd : beginAction:(System.AsyncCallback * obj -> System.IAsyncResult) * endAction:(System.IAsyncResult -> 'T) * ?cancelAction : (unit -> unit) -> Async<'T> @@ -531,7 +883,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation wrapping the given Begin/End functions. /// /// Legacy .NET Async Interoperability - /// + /// /// static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * System.AsyncCallback * obj -> System.IAsyncResult) * endAction:(System.IAsyncResult -> 'T) * ?cancelAction : (unit -> unit) -> Async<'T> @@ -542,7 +894,7 @@ namespace Microsoft.FSharp.Control /// The computation will respond to cancellation while waiting for the completion /// of the operation. If a cancellation occurs, and cancelAction is specified, then it is /// executed, and the computation continues to wait for the completion of the operation. - /// + /// /// If cancelAction is not specified, then cancellation causes the computation /// to stop immediately, and subsequent invocations of the callback are ignored. /// @@ -555,7 +907,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation wrapping the given Begin/End functions. /// /// Legacy .NET Async Interoperability - /// + /// /// static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * System.AsyncCallback * obj -> System.IAsyncResult) * endAction:(System.IAsyncResult -> 'T) * ?cancelAction : (unit -> unit) -> Async<'T> @@ -565,7 +917,7 @@ namespace Microsoft.FSharp.Control /// The computation will respond to cancellation while waiting for the completion /// of the operation. If a cancellation occurs, and cancelAction is specified, then it is /// executed, and the computation continues to wait for the completion of the operation. - /// + /// /// If cancelAction is not specified, then cancellation causes the computation /// to stop immediately, and subsequent invocations of the callback are ignored. /// @@ -579,7 +931,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation wrapping the given Begin/End functions. /// /// Legacy .NET Async Interoperability - /// + /// /// static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * System.AsyncCallback * obj -> System.IAsyncResult) * endAction:(System.IAsyncResult -> 'T) * ?cancelAction : (unit -> unit) -> Async<'T> @@ -592,7 +944,7 @@ namespace Microsoft.FSharp.Control /// A tuple of the begin, end, and cancel members. /// /// Legacy .NET Async Interoperability - /// + /// /// static member AsBeginEnd : computation:('Arg -> Async<'T>) -> // The 'Begin' member @@ -610,8 +962,21 @@ namespace Microsoft.FSharp.Control /// A computation that is equivalent to the input computation, but disregards the result. /// /// Composing Async Computations - /// - /// + /// + /// + /// + /// let readFile filename numBytes = + /// async { + /// use file = System.IO.File.OpenRead(filename) + /// printfn "Reading from file %s." filename + /// // Throw away the data being read. + /// do! file.AsyncRead(numBytes) |> Async.Ignore + /// } + /// readFile "example.txt" 42 |> Async.Start + /// + /// Reads bytes from a given file asynchronously and then ignores the result, allowing the do! to be used with functions + /// that return an unwanted value. + /// static member Ignore : computation: Async<'T> -> Async /// Runs an asynchronous computation, starting immediately on the current operating system @@ -628,14 +993,14 @@ namespace Microsoft.FSharp.Control /// The default is used if this parameter is not provided. /// /// Starting Async Computations - /// + /// /// static member StartWithContinuations: computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken-> unit - /// + /// /// static member internal StartWithContinuationsUsingDispatchInfo: computation:Async<'T> * @@ -652,8 +1017,21 @@ namespace Microsoft.FSharp.Control /// The default is used if this parameter is not provided. /// /// Starting Async Computations - /// - /// + /// + /// + /// + /// printfn "A" + /// + /// async { + /// printfn "B" + /// do! Async.Sleep(1000) + /// printfn "C" + /// } |> Async.StartImmediate + /// + /// printfn "D" + /// + /// Prints "A", "B", "D" immediately, then "C" in 1 second + /// static member StartImmediate: computation:Async * ?cancellationToken:CancellationToken-> unit @@ -674,8 +1052,24 @@ namespace Microsoft.FSharp.Control /// in the corresponding state once the computation terminates (produces the result, throws exception or gets canceled) /// /// Starting Async Computations - /// - /// + /// + /// + /// + /// printfn "A" + /// + /// let t = + /// async { + /// printfn "B" + /// do! Async.Sleep(1000) + /// printfn "C" + /// } |> Async.StartImmediateAsTask + /// + /// printfn "D" + /// t.Wait() + /// printfn "E" + /// + /// Prints "A", "B", "D" immediately, then "C", "E" in 1 second. + /// static member StartImmediateAsTask: computation:Async<'T> * ?cancellationToken:CancellationToken-> Task<'T> @@ -694,33 +1088,33 @@ namespace Microsoft.FSharp.Control /// The F# compiler emits calls to this function to implement F# async expressions. /// /// A value indicating asynchronous execution. - /// + /// /// member IsCancellationRequested: bool /// The F# compiler emits calls to this function to implement F# async expressions. /// /// A value indicating asynchronous execution. - /// + /// /// static member Success: AsyncActivation<'T> -> result: 'T -> AsyncReturn /// The F# compiler emits calls to this function to implement F# async expressions. /// /// A value indicating asynchronous execution. - /// + /// /// member OnSuccess: result: 'T -> AsyncReturn /// The F# compiler emits calls to this function to implement F# async expressions. - /// + /// /// member OnExceptionRaised: unit -> unit /// The F# compiler emits calls to this function to implement F# async expressions. /// /// A value indicating asynchronous execution. - /// + /// /// member OnCancellation: unit -> AsyncReturn @@ -830,7 +1224,7 @@ namespace Microsoft.FSharp.Control /// /// An asynchronous computation that will enumerate the sequence and run body /// for each element. - /// + /// /// member For: sequence:seq<'T> * body:('T -> Async) -> Async @@ -841,7 +1235,7 @@ namespace Microsoft.FSharp.Control /// The existence of this method permits the use of empty else branches in the /// async { ... } computation expression syntax. /// An asynchronous computation that returns (). - /// + /// /// member Zero : unit -> Async @@ -857,7 +1251,7 @@ namespace Microsoft.FSharp.Control /// The second part of the sequenced computation. /// /// An asynchronous computation that runs both of the computations sequentially. - /// + /// /// member inline Combine : computation1:Async * computation2:Async<'T> -> Async<'T> @@ -874,7 +1268,7 @@ namespace Microsoft.FSharp.Control /// of a while expression. /// /// An asynchronous computation that behaves similarly to a while loop when run. - /// + /// /// member While : guard:(unit -> bool) * computation:Async -> Async @@ -888,7 +1282,7 @@ namespace Microsoft.FSharp.Control /// The value to return from the computation. /// /// An asynchronous computation that returns value when executed. - /// + /// /// member inline Return : value:'T -> Async<'T> @@ -900,7 +1294,7 @@ namespace Microsoft.FSharp.Control /// The input computation. /// /// The input computation. - /// + /// /// member inline ReturnFrom : computation:Async<'T> -> Async<'T> @@ -911,7 +1305,7 @@ namespace Microsoft.FSharp.Control /// The function to run. /// /// An asynchronous computation that runs generator. - /// + /// /// member Delay : generator:(unit -> Async<'T>) -> Async<'T> @@ -929,7 +1323,7 @@ namespace Microsoft.FSharp.Control /// computation. /// /// An asynchronous computation that binds and eventually disposes resource. - /// + /// /// member Using: resource:'T * binder:('T -> Async<'U>) -> Async<'U> when 'T :> System.IDisposable @@ -946,7 +1340,7 @@ namespace Microsoft.FSharp.Control /// /// An asynchronous computation that performs a monadic bind on the result /// of computation. - /// + /// /// member inline Bind: computation: Async<'T> * binder: ('T -> Async<'U>) -> Async<'U> @@ -965,7 +1359,7 @@ namespace Microsoft.FSharp.Control /// /// An asynchronous computation that executes computation and compensation afterwards or /// when an exception is raised. - /// + /// /// member inline TryFinally : computation:Async<'T> * compensation:(unit -> unit) -> Async<'T> @@ -982,7 +1376,7 @@ namespace Microsoft.FSharp.Control /// /// An asynchronous computation that executes computation and calls catchHandler if an /// exception is thrown. - /// + /// /// member inline TryWith : computation:Async<'T> * catchHandler:(exn -> Async<'T>) -> Async<'T> diff --git a/src/FSharp.Core/fslib-extra-pervasives.fs b/src/FSharp.Core/fslib-extra-pervasives.fs index 90304bd36dc..01fd7018b11 100644 --- a/src/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/FSharp.Core/fslib-extra-pervasives.fs @@ -461,7 +461,11 @@ type TypeProviderTypeAttributes = | SuppressRelocate = 0x80000000 | IsErased = 0x40000000 -type TypeProviderConfig(systemRuntimeContainsType: string -> bool) = +type TypeProviderConfig + ( + systemRuntimeContainsType: string -> bool, + getReferencedAssembliesOption: (unit -> string array) option + ) = let mutable resolutionFolder: string = null let mutable runtimeAssembly: string = null let mutable referencedAssemblies: string[] = null @@ -470,6 +474,11 @@ type TypeProviderConfig(systemRuntimeContainsType: string -> bool) = let mutable useResolutionFolderAtRuntime: bool = false let mutable systemRuntimeAssemblyVersion: System.Version = null + new(systemRuntimeContainsType) = TypeProviderConfig(systemRuntimeContainsType, getReferencedAssembliesOption = None) + + new(systemRuntimeContainsType, getReferencedAssemblies) = + TypeProviderConfig(systemRuntimeContainsType, getReferencedAssembliesOption = Some getReferencedAssemblies) + member _.ResolutionFolder with get () = resolutionFolder and set v = resolutionFolder <- v @@ -479,8 +488,15 @@ type TypeProviderConfig(systemRuntimeContainsType: string -> bool) = and set v = runtimeAssembly <- v member _.ReferencedAssemblies - with get () = referencedAssemblies - and set v = referencedAssemblies <- v + with get () = + match getReferencedAssembliesOption with + | None -> referencedAssemblies + | Some f -> f () + + and set v = + match getReferencedAssembliesOption with + | None -> referencedAssemblies <- v + | Some _ -> raise (InvalidOperationException()) member _.TemporaryFolder with get () = temporaryFolder diff --git a/src/FSharp.Core/fslib-extra-pervasives.fsi b/src/FSharp.Core/fslib-extra-pervasives.fsi index 29915a1b5ba..ea1ec13f767 100644 --- a/src/FSharp.Core/fslib-extra-pervasives.fsi +++ b/src/FSharp.Core/fslib-extra-pervasives.fsi @@ -454,8 +454,13 @@ namespace Microsoft.FSharp.Core.CompilerServices /// If the class that implements ITypeProvider has a constructor that accepts TypeProviderConfig /// then it will be constructed with an instance of TypeProviderConfig. type TypeProviderConfig = + + /// Create a configuration which calls the given function for the corresponding operation. new : systemRuntimeContainsType : (string -> bool) -> TypeProviderConfig + /// Create a configuration which calls the given functions for the corresponding operation. + new : systemRuntimeContainsType : (string -> bool) * getReferencedAssemblies : (unit -> string[]) -> TypeProviderConfig + /// Get the full path to use to resolve relative paths in any file name arguments given to the type provider instance. member ResolutionFolder : string with get,set diff --git a/src/FSharp.Core/local.fsi b/src/FSharp.Core/local.fsi index e4d26e76e2b..2af9465beaf 100644 --- a/src/FSharp.Core/local.fsi +++ b/src/FSharp.Core/local.fsi @@ -1,6 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. namespace Microsoft.FSharp.Core + open Microsoft.FSharp.Core [] diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index 1178620d63b..0489528c062 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -601,20 +601,19 @@ namespace Microsoft.FSharp.Core // duplicated from above since we're using integers in this section let CompilationRepresentationFlags_PermitNull = 8 - let getTypeInfo (ty:Type) = - if ty.IsValueType + let private getTypeInfo<'T> = + if typeof<'T>.IsValueType then TypeNullnessSemantics_NullNever else - let mappingAttrs = ty.GetCustomAttributes(typeof, false) - if mappingAttrs.Length = 0 + if not (typeof<'T>.IsDefined(typeof, false)) then TypeNullnessSemantics_NullIsExtraValue - elif ty.Equals(typeof) then + elif typeof<'T>.Equals(typeof) then TypeNullnessSemantics_NullTrueValue - elif typeof.IsAssignableFrom(ty) then + elif typeof.IsAssignableFrom(typeof<'T>) then TypeNullnessSemantics_NullIsExtraValue - elif ty.GetCustomAttributes(typeof, false).Length > 0 then + elif typeof<'T>.IsDefined(typeof, false) then TypeNullnessSemantics_NullIsExtraValue else - let reprAttrs = ty.GetCustomAttributes(typeof, false) + let reprAttrs = typeof<'T>.GetCustomAttributes(typeof, false) if reprAttrs.Length = 0 then TypeNullnessSemantics_NullNotLiked else @@ -627,7 +626,7 @@ namespace Microsoft.FSharp.Core type TypeInfo<'T>() = // Compute an on-demand per-instantiation static field - static let info = getTypeInfo typeof<'T> + static let info = getTypeInfo<'T> // Publish the results of that computation static member TypeInfo = info @@ -3854,7 +3853,7 @@ namespace Microsoft.FSharp.Core [] type ValueOption<'T> = | ValueNone : 'T voption - | ValueSome : 'T -> 'T voption + | ValueSome : Item: 'T -> 'T voption member x.Value = match x with ValueSome x -> x | ValueNone -> raise (new InvalidOperationException("ValueOption.Value")) diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index ccac892f8fc..e639f3cb85e 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -2441,7 +2441,7 @@ namespace Microsoft.FSharp.Core /// The input value. /// /// An option representing the value. - | ValueSome: 'T -> 'T voption + | ValueSome: Item:'T -> 'T voption /// Get the value of a 'ValueSome' option. An InvalidOperationException is raised if the option is 'ValueNone'. member Value: 'T diff --git a/src/FSharp.Core/quotations.fs b/src/FSharp.Core/quotations.fs index 44c625de5f5..c3c7317e522 100644 --- a/src/FSharp.Core/quotations.fs +++ b/src/FSharp.Core/quotations.fs @@ -942,14 +942,8 @@ module Patterns = | VarSetOp, _ | AddressSetOp, _ -> typeof | AddressOfOp, [ expr ] -> (typeOf expr).MakeByRefType() - | (AddressOfOp - | QuoteOp _ - | SequentialOp - | TryWithOp - | TryFinallyOp - | IfThenElseOp - | AppOp), - _ -> failwith "unreachable" + | (AddressOfOp | QuoteOp _ | SequentialOp | TryWithOp | TryFinallyOp | IfThenElseOp | AppOp), _ -> + failwith "unreachable" //-------------------------------------------------------------------------- // Constructors for building Raw quotations @@ -2933,8 +2927,7 @@ module DerivedPatterns = let (|SpecificCall|_|) templateParameter = // Note: precomputation match templateParameter with - | (Lambdas (_, Call (_, minfo1, _)) - | Call (_, minfo1, _)) -> + | (Lambdas (_, Call (_, minfo1, _)) | Call (_, minfo1, _)) -> let isg1 = minfo1.IsGenericMethod let gmd = diff --git a/src/FSharp.Core/seqcore.fsi b/src/FSharp.Core/seqcore.fsi index 03496378232..701a92fc705 100644 --- a/src/FSharp.Core/seqcore.fsi +++ b/src/FSharp.Core/seqcore.fsi @@ -1,6 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. namespace Microsoft.FSharp.Collections + open System open System.Collections open System.Collections.Generic diff --git a/src/Microsoft.FSharp.Compiler/Program.fs b/src/Microsoft.FSharp.Compiler/Program.fs index 0a254518203..051a8f6f309 100644 --- a/src/Microsoft.FSharp.Compiler/Program.fs +++ b/src/Microsoft.FSharp.Compiler/Program.fs @@ -1,2 +1,2 @@ [] -let main _ = 0 \ No newline at end of file +let main _ = 0 diff --git a/src/fsc/fscmain.fs b/src/fsc/fscmain.fs index 9fc65db7cdc..1f1d7109304 100644 --- a/src/fsc/fscmain.fs +++ b/src/fsc/fscmain.fs @@ -37,7 +37,7 @@ let main (argv) = Thread.CurrentThread.Name <- "F# Main Thread" // Set the initial phase to garbage collector to batch mode, which improves overall performance. - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter // An SDL recommendation UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() diff --git a/src/fsi/fsimain.fs b/src/fsi/fsimain.fs index 57aee5ca360..d4394269ff4 100644 --- a/src/fsi/fsimain.fs +++ b/src/fsi/fsimain.fs @@ -394,16 +394,23 @@ let MainMain argv = || x = "/shadowcopyreferences+" || x = "--shadowcopyreferences+") - if + let executeFsi shadowCopyFiles = + if shadowCopyFiles then + let setupInformation = AppDomain.CurrentDomain.SetupInformation + setupInformation.ShadowCopyFiles <- "true" + let helper = AppDomain.CreateDomain("FSI_Domain", null, setupInformation) + helper.ExecuteAssemblyByName(Assembly.GetExecutingAssembly().GetName()) + else + evaluateSession (argv) + + let tryShadowCopy = AppDomain.CurrentDomain.IsDefaultAppDomain() && argv |> Array.exists isShadowCopy - then - let setupInformation = AppDomain.CurrentDomain.SetupInformation - setupInformation.ShadowCopyFiles <- "true" - let helper = AppDomain.CreateDomain("FSI_Domain", null, setupInformation) - helper.ExecuteAssemblyByName(Assembly.GetExecutingAssembly().GetName()) - else - evaluateSession (argv) + + try + executeFsi tryShadowCopy + with :? FileLoadException -> + executeFsi false #else evaluateSession (argv) #endif diff --git a/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj b/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj index 0217a4c96cc..c157669ba0a 100644 --- a/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj +++ b/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj @@ -20,9 +20,9 @@ content\myfiles\ - - - + + + diff --git a/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj b/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj index 080aea65994..b884948e8b8 100644 --- a/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj +++ b/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj @@ -2,7 +2,7 @@ Library - net7.0 + net6.0 $(TestTargetFramework) false $(FSharpCoreShippedPackageVersionValue) @@ -17,9 +17,9 @@ - - - + + + diff --git a/tests/EndToEndBuildTests/ComboProvider/ComboProvider/ComboProvider.fsproj b/tests/EndToEndBuildTests/ComboProvider/ComboProvider/ComboProvider.fsproj index 7834c472955..9fd278953c4 100644 --- a/tests/EndToEndBuildTests/ComboProvider/ComboProvider/ComboProvider.fsproj +++ b/tests/EndToEndBuildTests/ComboProvider/ComboProvider/ComboProvider.fsproj @@ -2,9 +2,9 @@ Library - net7.0;net472 + net6.0;net472 $(FSharpCoreShippedPackageVersionValue) - net7.0;net472 + net6.0;net472 diff --git a/tests/EndToEndBuildTests/ComboProvider/TestComboProvider.cmd b/tests/EndToEndBuildTests/ComboProvider/TestComboProvider.cmd index 29ad4ced449..fc72e514487 100644 --- a/tests/EndToEndBuildTests/ComboProvider/TestComboProvider.cmd +++ b/tests/EndToEndBuildTests/ComboProvider/TestComboProvider.cmd @@ -42,8 +42,8 @@ echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuratio dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net472 -p:FSharpTestCompilerVersion=net40 if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure -echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net7.0 -p:FSharpTestCompilerVersion=coreclr - dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net7.0 -p:FSharpTestCompilerVersion=coreclr +echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net6.0 -p:FSharpTestCompilerVersion=coreclr + dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net6.0 -p:FSharpTestCompilerVersion=coreclr if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure rem @@ -60,8 +60,8 @@ echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuratio dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net472 -p:FSharpTestCompilerVersion=net40 if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure -echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -v %configuration% -p:TestTargetFramework=net7.0 -p:FSharpTestCompilerVersion=coreclr - dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net7.0 -p:FSharpTestCompilerVersion=coreclr +echo dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -v %configuration% -p:TestTargetFramework=net6.0 -p:FSharpTestCompilerVersion=coreclr + dotnet test ComboProvider.Tests\ComboProvider.Tests.fsproj -c %configuration% -v minimal -p:TestTargetFramework=net6.0 -p:FSharpTestCompilerVersion=coreclr if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure :success diff --git a/tests/EndToEndBuildTests/EndToEndBuildTests.cmd b/tests/EndToEndBuildTests/EndToEndBuildTests.cmd index 7613f487e35..eba1498af91 100644 --- a/tests/EndToEndBuildTests/EndToEndBuildTests.cmd +++ b/tests/EndToEndBuildTests/EndToEndBuildTests.cmd @@ -27,9 +27,9 @@ echo %__scriptpath%BasicProvider\TestBasicProvider.cmd -c %configuration% call %__scriptpath%BasicProvider\TestBasicProvider.cmd -c %configuration% if ERRORLEVEL 1 echo Error: TestBasicProvider failed && goto :failure -echo %__scriptpath%ComboProvider\TestComboProvider.cmd -c %configuration% -call %__scriptpath%ComboProvider\TestComboProvider.cmd -c %configuration% -if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure +rem echo %__scriptpath%ComboProvider\TestComboProvider.cmd -c %configuration% +rem call %__scriptpath%ComboProvider\TestComboProvider.cmd -c %configuration% +rem if ERRORLEVEL 1 echo Error: TestComboProvider failed && goto :failure :success endlocal diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/warn.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/warn.fs index 1ba362eb86a..4e98ff92545 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/warn.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/warn.fs @@ -70,6 +70,18 @@ module TestCompilerWarningLevel = |> withDiagnosticMessageMatches "The value has been copied to ensure the original is not mutated by this operation or because the copy is implicit when returning a struct from a member and another member is then accessed$" |> ignore +#if NETSTANDARD +// This test works with KeyValuePair, which is not a 'readonly struct' in net472 + [] + let ``no error 52 with readonly struct`` compilation = + compilation + |> asExe + |> withOptions ["--warn:5"; "--warnaserror:52"] + |> compile + |> shouldSucceed + |> ignore +#endif + [] let ``warn_level6_fs --warn:6`` compilation = compilation diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Diags/Diags.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Diags/Diags.fs index 295ee002be7..95fe85e3678 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Diags/Diags.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Diags/Diags.fs @@ -17,7 +17,7 @@ module Diags = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 3, Line 7, Col 23, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 3, Line 7, Col 30, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=E_AdjustUses01b.fs SCFLAGS=--test:ErrorRanges # E_AdjustUses01b.fs @@ -28,6 +28,6 @@ module Diags = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 3, Line 7, Col 23, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 3, Line 7, Col 30, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Legacy/Legacy.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Legacy/Legacy.fs index e26e9b5d08b..af9e9f3472e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Legacy/Legacy.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/Legacy/Legacy.fs @@ -17,9 +17,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test02.fs SCFLAGS="--test:ErrorRanges" # Test02.fs @@ -30,9 +30,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 8, Col 5, Line 8, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 10, Col 5, Line 10, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 10, Col 5, Line 10, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test03.fs SCFLAGS="--test:ErrorRanges" # Test03.fs @@ -43,8 +43,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test04.fs SCFLAGS="--test:ErrorRanges" # Test04.fs @@ -55,9 +55,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test05.fs SCFLAGS="--test:ErrorRanges" # Test05.fs @@ -68,9 +68,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test06.fs SCFLAGS="--test:ErrorRanges" # Test06.fs @@ -81,8 +81,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test07.fs SCFLAGS="--test:ErrorRanges" # Test07.fs @@ -93,8 +93,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test08.fs SCFLAGS="--test:ErrorRanges" # Test08.fs @@ -105,8 +105,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test09.fs SCFLAGS="--test:ErrorRanges" # Test09.fs @@ -117,7 +117,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 6, Col 5, Line 6, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 6, Col 5, Line 6, Col 28, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") ] // SOURCE=Test10.fs SCFLAGS="--test:ErrorRanges" # Test10.fs @@ -128,9 +128,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 8, Col 5, Line 8, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 10, Col 5, Line 10, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 10, Col 5, Line 10, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test11.fs SCFLAGS="--test:ErrorRanges" # Test11.fs @@ -141,9 +141,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 8, Col 5, Line 8, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 10, Col 5, Line 10, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 10, Col 5, Line 10, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test12.fs SCFLAGS="--test:ErrorRanges" # Test12.fs @@ -154,8 +154,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test13.fs SCFLAGS="--test:ErrorRanges" # Test13.fs @@ -166,9 +166,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test14.fs SCFLAGS="--test:ErrorRanges" # Test14.fs @@ -179,9 +179,9 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 9, Col 5, Line 9, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 10, Col 5, Line 10, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 11, Col 5, Line 11, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 10, Col 5, Line 10, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 11, Col 5, Line 11, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test15.fs SCFLAGS="--test:ErrorRanges" # Test15.fs @@ -192,8 +192,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test16.fs SCFLAGS="--test:ErrorRanges" # Test16.fs @@ -204,8 +204,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 9, Col 5, Line 9, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test17.fs SCFLAGS="--test:ErrorRanges" # Test17.fs @@ -216,8 +216,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 6, Col 5, Line 6, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 6, Col 5, Line 6, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test18.fs SCFLAGS="--test:ErrorRanges" # Test18.fs @@ -228,7 +228,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 6, Col 5, Line 6, Col 22, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") + (Error 501, Line 6, Col 5, Line 6, Col 29, "The object constructor 'ReferenceEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> ReferenceEqualityAttribute'.") ] // SOURCE=Test19.fs SCFLAGS="--test:ErrorRanges" # Test19.fs @@ -239,8 +239,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test20.fs SCFLAGS="--test:ErrorRanges" # Test20.fs @@ -251,8 +251,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test21.fs SCFLAGS="--test:ErrorRanges" # Test21.fs @@ -263,7 +263,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 6, Col 5, Line 6, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 6, Col 5, Line 6, Col 31, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test22.fs SCFLAGS="--test:ErrorRanges" # Test22.fs @@ -274,8 +274,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 8, Col 5, Line 8, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 8, Col 5, Line 8, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test23.fs SCFLAGS="--test:ErrorRanges" # Test23.fs @@ -286,8 +286,8 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 9, Col 5, Line 9, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") - (Error 501, Line 10, Col 5, Line 10, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 9, Col 5, Line 9, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 10, Col 5, Line 10, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test24.fs SCFLAGS="--test:ErrorRanges" # Test24.fs @@ -298,7 +298,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 6, Col 5, Line 6, Col 25, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") + (Error 501, Line 6, Col 5, Line 6, Col 32, "The object constructor 'StructuralComparisonAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralComparisonAttribute'.") ] // SOURCE=Test25.fs SCFLAGS="--test:ErrorRanges" # Test25.fs @@ -309,7 +309,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 29, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test26.fs SCFLAGS="--test:ErrorRanges" # Test26.fs @@ -320,7 +320,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 5, Line 7, Col 23, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 5, Line 7, Col 30, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] // SOURCE=Test27.fs SCFLAGS="--test:ErrorRanges" # Test27.fs @@ -340,7 +340,7 @@ module Legacy = |> compile |> shouldFail |> withDiagnostics [ - (Error 501, Line 7, Col 3, Line 7, Col 21, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") + (Error 501, Line 7, Col 3, Line 7, Col 28, "The object constructor 'StructuralEqualityAttribute' takes 0 argument(s) but is here given 1. The required signature is 'new: unit -> StructuralEqualityAttribute'.") ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index eeac02384ab..0161db9cd6e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -79,8 +79,8 @@ module AttributeUsage = |> shouldFail |> withDiagnostics [ (Error 842, Line 21, Col 21, Line 21, Col 22, "This attribute is not valid for use on this language element") - (Error 842, Line 24, Col 28, Line 24, Col 29, "This attribute is not valid for use on this language element") - (Error 842, Line 27, Col 15, Line 27, Col 16, "This attribute is not valid for use on this language element") + (Error 842, Line 24, Col 21, Line 24, Col 29, "This attribute is not valid for use on this language element") + (Error 842, Line 27, Col 7, Line 27, Col 16, "This attribute is not valid for use on this language element") ] // SOURCE=E_AttributeTargets02.fs # E_AttributeTargets02.fs @@ -90,9 +90,9 @@ module AttributeUsage = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 842, Line 14, Col 17, Line 14, Col 34, "This attribute is not valid for use on this language element") - (Error 842, Line 24, Col 14, Line 24, Col 29, "This attribute is not valid for use on this language element") - (Error 842, Line 29, Col 25, Line 29, Col 40, "This attribute is not valid for use on this language element") + (Error 842, Line 14, Col 7, Line 14, Col 34, "This attribute is not valid for use on this language element") + (Error 842, Line 24, Col 7, Line 24, Col 36, "This attribute is not valid for use on this language element") + (Error 842, Line 29, Col 15, Line 29, Col 47, "This attribute is not valid for use on this language element") ] // SOURCE=E_ConditionalAttribute.fs SCFLAGS="--test:ErrorRanges" # E_ConditionalAttribute.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/Basic/Basic.fs index 8bc5e456829..829d0f86f79 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/CustomAttributes/Basic/Basic.fs @@ -41,7 +41,7 @@ module Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 841, Line 7, Col 12, Line 7, Col 49, "This attribute is not valid for use on this language element. Assembly attributes should be attached to a 'do ()' declaration, if necessary within an F# module.") + (Error 841, Line 7, Col 3, Line 7, Col 111, "This attribute is not valid for use on this language element. Assembly attributes should be attached to a 'do ()' declaration, if necessary within an F# module.") ] // SOURCE=E_AttributeApplication02.fs SCFLAGS="--test:ErrorRanges" # E_AttributeApplication02.fs @@ -106,8 +106,8 @@ module Basic = (Error 1, Line 10, Col 3, Line 10, Col 59, "This expression was expected to have type\n 'int array' \nbut here has type\n 'unit' ") (Error 267, Line 10, Col 3, Line 10, Col 59, "This is not a valid constant expression or custom attribute value") (Error 850, Line 10, Col 3, Line 10, Col 59, "This attribute cannot be used in this version of F#") - (Error 850, Line 13, Col 3, Line 13, Col 52, "This attribute cannot be used in this version of F#") - (Error 850, Line 16, Col 13, Line 16, Col 37, "This attribute cannot be used in this version of F#") + (Error 850, Line 13, Col 3, Line 13, Col 101, "This attribute cannot be used in this version of F#") + (Error 850, Line 16, Col 3, Line 16, Col 50, "This attribute cannot be used in this version of F#") ] // SOURCE=E_AttributeTargetSpecifications.fs # E_AttributeTargetSpecifications.fs @@ -305,7 +305,7 @@ module Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 429, Line 16, Col 28, Line 16, Col 31, "The attribute type 'CA1' has 'AllowMultiple=false'. Multiple instances of this attribute cannot be attached to a single language element.") + (Error 429, Line 16, Col 28, Line 16, Col 37, "The attribute type 'CA1' has 'AllowMultiple=false'. Multiple instances of this attribute cannot be attached to a single language element.") ] // SOURCE=W_StructLayoutExplicit01.fs SCFLAGS="--test:ErrorRanges" PEVER="/Exp_Fail" # W_StructLayoutExplicit01.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs index fc9e36d748e..c472ec9b0ea 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs @@ -53,9 +53,9 @@ module Basic = |> shouldFail |> withDiagnostics [ (Error 683, Line 14, Col 6, Line 14, Col 27, "Attributes are not allowed within patterns") - (Error 842, Line 14, Col 8, Line 14, Col 23, "This attribute is not valid for use on this language element") + (Error 842, Line 14, Col 8, Line 14, Col 25, "This attribute is not valid for use on this language element") (Error 683, Line 14, Col 42, Line 14, Col 63, "Attributes are not allowed within patterns") - (Error 842, Line 14, Col 44, Line 14, Col 59, "This attribute is not valid for use on this language element") + (Error 842, Line 14, Col 44, Line 14, Col 61, "This attribute is not valid for use on this language element") ] // SOURCE=E_ErrorsForInlineValue.fs SCFLAGS="--test:ErrorRanges" # E_ErrorsForInlineValue.fs diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/StructDefensiveCopy/StructDefensiveCopy.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/StructDefensiveCopy/StructDefensiveCopy.fs new file mode 100644 index 00000000000..fe7f88ff74a --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/StructDefensiveCopy/StructDefensiveCopy.fs @@ -0,0 +1,158 @@ +module FSharp.Compiler.ComponentTests.EmittedIL.StructDefensiveCopy + +open Xunit +open System.IO +open FSharp.Test +open FSharp.Test.Compiler + +let verifyKeyValuePairInstanceMethodCall expectedIl = + FSharp """ +module StructUnion01 +open System.Runtime.CompilerServices +open System.Collections.Generic + +let doWork(kvp1:inref>) = + kvp1.ToString() + """ + |> ignoreWarnings + |> compile + |> shouldSucceed + |> verifyIL expectedIl + +#if NETSTANDARD +// KeyValuePair defined as a readonly struct (in C#) +[] +let ``Defensive copy can be skipped on read-only structs``() = + verifyKeyValuePairInstanceMethodCall [""" .method public static string doWork([in] valuetype [runtime]System.Collections.Generic.KeyValuePair`2& kvp1) cil managed + { + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.IsReadOnlyAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: constrained. valuetype [runtime]System.Collections.Generic.KeyValuePair`2 + IL_0007: callvirt instance string [runtime]System.Object::ToString() + IL_000c: ret + } + +} """] + +#else +// KeyValuePair just a regular struct. Notice the "ldobj" instruction +[] +let ``Non readonly struct needs a defensive copy``() = + verifyKeyValuePairInstanceMethodCall [""" .method public static string doWork([in] valuetype [runtime]System.Collections.Generic.KeyValuePair`2& kvp1) cil managed + { + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.IsReadOnlyAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 3 + .locals init (valuetype [runtime]System.Collections.Generic.KeyValuePair`2 V_0) + IL_0000: ldarg.0 + IL_0001: ldobj valuetype [runtime]System.Collections.Generic.KeyValuePair`2 + IL_0006: stloc.0 + IL_0007: ldloca.s V_0 + IL_0009: constrained. valuetype [runtime]System.Collections.Generic.KeyValuePair`2 + IL_000f: callvirt instance string [runtime]System.Object::ToString() + IL_0014: ret + } """] +#endif + +let verifyDateTimeExtensionMethodCall expectedIl = + FSharp """ +module DateTimeExtensionMethod + +open System +open System.Collections.Generic +open System.Runtime.CompilerServices + +[] +type DateTimeExtensions = + [] + static member PrintDate(d: inref) = d.ToString() + +let doWork(dt:inref) = + dt.PrintDate() + """ + |> ignoreWarnings + |> compile + |> shouldSucceed + |> verifyIL expectedIl + +#if NETSTANDARD +// DateTime defined as a readonly struct (in C#) +[] +let ``Defensive copy can be skipped for extension methods on read-only structs``() = + verifyDateTimeExtensionMethodCall [""" .method public static string doWork([in] valuetype [runtime]System.DateTime& dt) cil managed + { + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.IsReadOnlyAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: constrained. [runtime]System.DateTime + IL_0007: callvirt instance string [runtime]System.Object::ToString() + IL_000c: ret + } """] + +#else +// DateTime just a regular struct. Notice the "ldobj" instruction +[] +let ``Non readonly struct needs a defensive copy when its extension method is called``() = + verifyDateTimeExtensionMethodCall [""" .method public static string doWork([in] valuetype [runtime]System.DateTime& dt) cil managed + { + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.IsReadOnlyAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 3 + .locals init (valuetype [runtime]System.DateTime& V_0, + valuetype [runtime]System.DateTime V_1) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: ldobj [runtime]System.DateTime + IL_0008: stloc.1 + IL_0009: ldloca.s V_1 + IL_000b: constrained. [runtime]System.DateTime + IL_0011: callvirt instance string [runtime]System.Object::ToString() + IL_0016: ret + } """] +#endif + + +#if NETSTANDARD +[] +#endif +let ``Csharp extension method on a readonly struct does not need defensive copy``() = + let csLib = + CSharp """ +using System; +public static class DateTimeExtensionMethod +{ + public static string CustomPrintDate(this in DateTime d) + { + return d.Date.ToShortDateString(); + } +}""" |> withName "CsLib" + + FSharp """ +module DateTimeDefinedInCsharpUsage +open System +let doWork(dt:inref) = + dt.CustomPrintDate() + """ + |> withReferences [csLib] + |> ignoreWarnings + |> compile + |> shouldSucceed + |> verifyIL [""" .method public static string doWork([in] valuetype [runtime]System.DateTime& dt) cil managed + { + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.IsReadOnlyAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call string [CsLib]DateTimeExtensionMethod::CustomPrintDate(valuetype [runtime]System.DateTime&) + IL_0006: ret + } """] + diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs new file mode 100644 index 00000000000..b64dff5176c --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs @@ -0,0 +1,72 @@ +module FSharp.Compiler.ComponentTests.ErrorMessages.UnionCasePatternMatchingErrors + +open Xunit +open FSharp.Test.Compiler + +[] +let ``Union matching error - Incomplete union fields`` () = + FSharp """ +module Tests +type U = + | B of f1:int list * {|X:string|} * f3:U * f4: (int * System.String) + +let x : U = failwith "" +let myVal = + match x with + | B -> 42""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 9, Col 7, Line 9, Col 8, + "This union case expects 4 arguments in tupled form, but was given 0. The missing field arguments may be any of: +\tf1: int list +\t{| X: string |} +\tf3: U +\tf4: (int * System.String)") + +[] +let ``Union matching error - Named args - Name used twice`` () = + FSharp """ +module Tests +type U = + | B of field: int * int +let x : U = failwith "" +let myVal = + match x with + | B (field = x; field = z) -> let y = x + z + 1 in ()""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 3175, Line 8, Col 21, Line 8, Col 26, "Union case/exception field 'field' cannot be used more than once.") + +[] +let ``Union matching error - Multiple tupled args`` () = + FSharp """ +module Tests +type U = + | B of field: int * int + +let x : U = failwith "" +let myVal = + match x with + | B x z -> let y = x + z + 1 in ()""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 9, Col 7, Line 9, Col 12, "This union case expects 2 arguments in tupled form, but was given 0. The missing field arguments may be any of: +\tfield: int +\tint") + +[] +let ``Union matching error - Missing field`` () = + FSharp """ +module Tests +type U = + | A + | B of int * int * int + +let myVal = + match A with + | A -> 15 + | B (x, _) -> 16""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 10, Col 7, Line 10, Col 15, "This union case expects 3 arguments in tupled form, but was given 2. The missing field arguments may be any of: +\tint") \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs index 439b0bd7bdb..276bad5963c 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs @@ -27,7 +27,7 @@ type C() = Range = { StartLine = 3 StartColumn = 13 EndLine = 3 - EndColumn = 37 } + EndColumn = 41 } Message = "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } { Error = Warning 202 @@ -41,7 +41,7 @@ type C() = Range = { StartLine = 6 StartColumn = 22 EndLine = 6 - EndColumn = 78 } + EndColumn = 82 } Message = "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } { Error = Warning 202 diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index e6e08b27af7..75e0f8a0323 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -134,6 +134,7 @@ + @@ -158,7 +159,9 @@ + + @@ -183,6 +186,7 @@ + @@ -212,8 +216,15 @@ - + + + + + + + + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/MultiDimensionalArrayTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/MultiDimensionalArrayTests.fs new file mode 100644 index 00000000000..7a107e1e910 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/MultiDimensionalArrayTests.fs @@ -0,0 +1,52 @@ +namespace FSharp.Compiler.ComponentTests.Language + +open Xunit +open FSharp.Test.Compiler + +module MultiDimensionalArrayTests = + + [] + [] + [] + [] + let ``MultiDimensional array type can be written with or without backticks`` (commas: int, shortcut: string) = + let commaString = System.String(',', commas) + + FSharp + $""" +module MultiDimArrayTests +let backTickStyle : int ``[{commaString}]`` = Unchecked.defaultof<_> +let cleanStyle : int [{commaString}] = backTickStyle +let shortCutStyle : int {shortcut} = cleanStyle + """ + |> compile + |> shouldSucceed + + [] + let ``Multidimensional array - reports an error if types are not matching`` () = + let commaString = System.String(',', 30) + + FSharp + $""" +module MultiDimArrayErrorTests +let cleanStyle : int [{commaString}] = Unchecked.defaultof<_> +let shortCutStyle : int array32d = cleanStyle + """ + |> compile + |> shouldFail + |> withSingleDiagnostic (Error 1, Line 4, Col 36, Line 4, Col 46, "This expression was expected to have type + 'int array32d' +but here has type + 'int array31d' ") + + [] + let ``Multidimensional with rank over 32 cannot be defined`` () = + let commaString = System.String(',', 42) + + FSharp + $""" +module MultiDimArrayErrorTests +let cleanStyle : int [{commaString}] = Unchecked.defaultof<_> + """ + |> compile + |> shouldFail diff --git a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs index c2fa57509fc..20e785370a3 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/ObsoleteAttributeCheckingTests.fs @@ -205,10 +205,80 @@ C.Update() |> shouldFail |> withDiagnostics [ (Error 101, Line 9, Col 1, Line 9, Col 9, "This construct is deprecated. Use B instead") - ] + ] [] - let ``Obsolete attribute is taken into account when used on an enum and invocation`` () = + let ``Obsolete attribute error is taken into account when used on a struct du and invocation`` () = + Fsx """ +open System +[] +[] +type Color = + | Red + | Green + +let c = Color.Red + """ + |> ignoreWarnings + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 9, Col 9, Line 9, Col 14, "This construct is deprecated. Use B instead") + ] + + [] + let ``Obsolete attribute error is taken into account when used on a du and invocation`` () = + Fsx """ +open System +[] +type Color = + | Red + | Green + +let c = Color.Red + """ + |> ignoreWarnings + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 8, Col 9, Line 8, Col 14, "This construct is deprecated. Use B instead") + ] + + [] + let ``Obsolete attribute error is taken into account when used on a du field and invocation`` () = + Fsx """ +open System +type Color = + | [] Red + | Green + +let c = Color.Red + """ + |> ignoreWarnings + |> compile + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 7, Col 9, Line 7, Col 18, "This construct is deprecated. Use B instead") + ] + + [] + let ``Obsolete attribute warning is taken into account when used on a du field and invocation`` () = + Fsx """ +open System +type Color = + | [] Red + | Green + +let c = Color.Red + """ + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 7, Col 9, Line 7, Col 18, "This construct is deprecated. Use B instead") + ] + + [] + let ``Obsolete attribute error is taken into account when used on an enum and invocation`` () = Fsx """ open System @@ -219,15 +289,14 @@ type Color = let c = Color.Red """ - |> ignoreWarnings |> compile |> shouldFail |> withDiagnostics [ (Error 101, Line 9, Col 9, Line 9, Col 14, "This construct is deprecated. Use B instead") ] - + [] - let ``Obsolete attribute is taken into account when used on an enum entry and invocation`` () = + let ``Obsolete attribute error is taken into account when used on an enum field and invocation`` () = Fsx """ open System @@ -237,9 +306,28 @@ type Color = let c = Color.Red """ - |> ignoreWarnings |> compile - |> shouldSucceed + |> shouldFail + |> withDiagnostics [ + (Error 101, Line 8, Col 9, Line 8, Col 18, "This construct is deprecated. Use B instead") + ] + + [] + let ``Obsolete attribute warning is taken into account when used on an enum field and invocation`` () = + Fsx """ +open System + +type Color = + | [] Red = 0 + | Green = 1 + +let c = Color.Red + """ + |> compile + |> shouldFail + |> withDiagnostics [ + (Warning 44, Line 8, Col 9, Line 8, Col 18, "This construct is deprecated. Use B instead") + ] [] let ``Obsolete attribute is taken into account when used on an type and use extension method`` () = @@ -899,6 +987,7 @@ Class.ObsoleteEvent |> ignore (Warning 44, Line 3, Col 1, Line 3, Col 20, "This construct is deprecated. Field is obsolete"); (Warning 44, Line 4, Col 1, Line 4, Col 21, "This construct is deprecated. Method is obsolete"); (Warning 44, Line 5, Col 1, Line 5, Col 23, "This construct is deprecated. Property is obsolete") + (Warning 44, Line 6, Col 1, Line 6, Col 20, "This construct is deprecated. Event is obsolete") ] [] @@ -937,4 +1026,5 @@ Class.ObsoleteEvent |> ignore (Error 101, Line 3, Col 1, Line 3, Col 20, "This construct is deprecated. Field is obsolete"); (Error 101, Line 4, Col 1, Line 4, Col 21, "This construct is deprecated. Method is obsolete"); (Error 101, Line 5, Col 1, Line 5, Col 23, "This construct is deprecated. Property is obsolete") + (Error 101, Line 6, Col 1, Line 6, Col 20, "This construct is deprecated. Event is obsolete") ] diff --git a/tests/FSharp.Compiler.ComponentTests/Language/XmlComments.fs b/tests/FSharp.Compiler.ComponentTests/Language/XmlComments.fs index fc554d1fcc9..c0378ae4208 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/XmlComments.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/XmlComments.fs @@ -206,4 +206,28 @@ module M = |> ignoreWarnings |> compile |> shouldSucceed - |> withDiagnostics [ ] \ No newline at end of file + |> withDiagnostics [ ] + + [] + let ``Union field - unnamed 01`` () = + Fsx""" + type A = + /// A + /// Item + | A of int + """ + |> withXmlCommentChecking + |> compile + |> withDiagnostics [ Warning 3390, Line 3, Col 13, Line 4, Col 48, "This XML comment is invalid: unknown parameter 'Item'" ] + + [] + let ``Union field - unnamed 02`` () = + Fsx""" + type A = + /// A + /// a + | A of int * a: int + """ + |> withXmlCommentChecking + |> compile + |> withDiagnostics [ ] diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/ArrayTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/ArrayTests.fs index 2317005032f..da6c65b1c82 100644 --- a/tests/FSharp.Compiler.ComponentTests/Signatures/ArrayTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/ArrayTests.fs @@ -32,17 +32,16 @@ let ``4 dimensional array`` () = "val a: int array4d" [] -let ``5 till 32 dimensional array`` () = - [ 5 .. 32 ] - |> List.iter (fun idx -> - let arrayType = - [ 1 .. idx ] - |> List.fold (fun acc _ -> $"array<{acc}>") "int" - - assertSingleSignatureBinding - $"let a : {arrayType} = failwith \"todo\"" - $"val a: int array{idx}d" - ) +let ``jagged array 1`` () = + assertSingleSignatureBinding + "let a : array>>>> = failwith \"todo\"" + "val a: int array array array array array" + +[] +let ``jagged array 2`` () = + assertSingleSignatureBinding + "let a: int[][][][][] = failwith \"todo\"" + "val a: int array array array array array" [] let ``Use array2d syntax in implementation`` () = diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs new file mode 100644 index 00000000000..9e187de1388 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs @@ -0,0 +1,61 @@ +module FSharp.Compiler.ComponentTests.TypeChecks.ParallelCheckingWithSignatureFilesTests + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +[] +let ``Parallel type checking when signature files are available`` () = + // File structure: + // Encode.fsi + // Encode.fs + // Decode.fsi + // Decode.fs + // Program.fs + + let encodeFsi = + Fsi + """ +module Encode + +val encode: obj -> string +""" + + let encodeFs = + SourceCodeFileKind.Create( + "Encode.fs", + """ +module Encode + +let encode (v: obj) : string = failwith "todo" +""" + ) + + let decodeFsi = + SourceCodeFileKind.Create( + "Decode.fsi", + """ +module Decode + +val decode: string -> obj +""" + ) + + let decodeFs = + SourceCodeFileKind.Create( + "Decode.fs", + """ +module Decode + +let decode (v: string) : obj = failwith "todo" +""" + ) + + let programFs = SourceCodeFileKind.Create("Program.fs", "printfn \"Hello from F#\"") + + encodeFsi + |> withAdditionalSourceFiles [ encodeFs; decodeFsi; decodeFs; programFs ] + |> withOptions [ "--test:ParallelCheckingWithSignatureFilesOn" ] + |> asExe + |> compile + |> shouldSucceed diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/nowarn_readonlystruct.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/nowarn_readonlystruct.fs new file mode 100644 index 00000000000..2a4f0152709 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/nowarn_readonlystruct.fs @@ -0,0 +1,9 @@ +// #Regression #NoMT #CompilerOptions +// See DevDiv:364238 +open System.Collections.Generic + +let x : IEnumerator> = failwith "" +printfn "%A" x.Current.Key // no defensive copy needed, because KeyValuePair is a "readonly struct" + +let y : list> = failwith "" // KeyValuePair +printfn "%A" y.[0].Key // no defensive copy needed, because KeyValuePair is a "readonly struct" diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/warn_level5.fs b/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/warn_level5.fs index d33dfcf9eec..2b6115e5718 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/warn_level5.fs +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/CompilerOptions/fsc/warn/warn_level5.fs @@ -2,8 +2,12 @@ // See DevDiv:364238 open System.Collections.Generic -let x : IEnumerator> = failwith "" -printfn "%A" x.Current.Key // defensive copy +[] +type NonReadOnlyStruct= + member val Property = "" with get, set -let y : list> = failwith "" -printfn "%A" y.[0].Key // defensive copy +let x : IEnumerator = failwith "" +printfn "%A" x.Current.Property // defensive copy + +let y : list = failwith "" // KeyValuePair +printfn "%A" y.[0].Property // defensive copy diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index c218cc2f408..2c4a8dd198f 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -16,6 +16,15 @@ open Xunit type InteractiveTests() = + [] + member _.``ValueRestriction error message should not have type variables fully solved``() = + use script = new FSharpScript() + let code = "id id" + let _, errors = script.Eval(code) + Assert.Equal(1, errors.Length) + let msg = errors[0].Message + Assert.Matches("'_\\w+ -> '_\\w+", msg) + [] member _.``Eval object value``() = use script = new FSharpScript() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index fae9537443b..c5b206ed9e6 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -101,6 +101,9 @@ SyntaxTree\MemberFlagTests.fs + + SyntaxTree\MemberTests.fs + SyntaxTree\ComputationExpressionTests.fs @@ -113,6 +116,18 @@ SyntaxTree\OperatorNameTests.fs + + SyntaxTree\SynIdentTests.fs + + + SyntaxTree\SynTypeTests.fs + + + SyntaxTree\AttributeTests.fs + + + SyntaxTree\ExternTests.fs + FileSystemTests.fs diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 083c2ea9310..9045f24ab29 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -1971,6 +1971,7 @@ FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServi FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServices.MethodGroup GetMethods(Int32, Int32, System.String, Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[System.String]]) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServices.SemanticClassificationItem[] GetSemanticClassification(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range]) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServices.ToolTipText GetDescription(FSharp.Compiler.Symbols.FSharpSymbol, Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`2[FSharp.Compiler.Symbols.FSharpGenericParameter,FSharp.Compiler.Symbols.FSharpType]], Boolean, FSharp.Compiler.Text.Range) +FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServices.ToolTipText GetKeywordTooltip(Microsoft.FSharp.Collections.FSharpList`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.EditorServices.ToolTipText GetToolTip(Int32, Int32, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String], Int32) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.Symbols.FSharpAssemblySignature PartialAssemblySignature FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: FSharp.Compiler.Symbols.FSharpAssemblySignature get_PartialAssemblySignature() @@ -2008,7 +2009,7 @@ FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String ToString() FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String[] DependencyFiles FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String[] get_DependencyFiles() FSharp.Compiler.CodeAnalysis.FSharpChecker -FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Create(Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.DateTime],Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[System.Object,System.IntPtr,System.Int32]]]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Create(Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.DateTime],Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[System.Object,System.IntPtr,System.Int32]]]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Instance FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker get_Instance() FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions GetProjectOptionsFromCommandLineArgs(System.String, System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) @@ -2029,12 +2030,9 @@ FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileAnswer]] ParseAndCheckFileInProject(System.String, Int32, FSharp.Compiler.Text.ISourceText, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults]] GetBackgroundCheckResultsForFileInProject(System.String, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpProjectOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]]] GetProjectOptionsFromScript(System.String, FSharp.Compiler.Text.ISourceText, Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime], Microsoft.FSharp.Core.FSharpOption`1[System.String[]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Int64], Microsoft.FSharp.Core.FSharpOption`1[System.String]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.Diagnostics.FSharpDiagnostic[],System.Int32]] Compile(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedInput], System.String, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.Diagnostics.FSharpDiagnostic[],System.Int32]] Compile(System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.Text.Range,FSharp.Compiler.Text.Range][]] MatchBraces(System.String, FSharp.Compiler.Text.ISourceText, FSharp.Compiler.CodeAnalysis.FSharpParsingOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`2[FSharp.Compiler.Text.Range,FSharp.Compiler.Text.Range][]] MatchBraces(System.String, System.String, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`3[FSharp.Compiler.Diagnostics.FSharpDiagnostic[],System.Int32,Microsoft.FSharp.Core.FSharpOption`1[System.Reflection.Assembly]]] CompileToDynamicAssembly(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedInput], System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[System.IO.TextWriter,System.IO.TextWriter]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.String]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`3[FSharp.Compiler.Diagnostics.FSharpDiagnostic[],System.Int32,Microsoft.FSharp.Core.FSharpOption`1[System.Reflection.Assembly]]] CompileToDynamicAssembly(System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[System.IO.TextWriter,System.IO.TextWriter]], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[FSharp.Compiler.CodeAnalysis.FSharpProjectOptions],FSharp.Compiler.CodeAnalysis.FSharpProjectOptions] ProjectChecked FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[FSharp.Compiler.CodeAnalysis.FSharpProjectOptions],FSharp.Compiler.CodeAnalysis.FSharpProjectOptions] get_ProjectChecked() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]],System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]] BeforeBackgroundFileCheck @@ -5528,26 +5526,44 @@ FSharp.Compiler.Syntax.ParsedImplFileFragment: Int32 Tag FSharp.Compiler.Syntax.ParsedImplFileFragment: Int32 get_Tag() FSharp.Compiler.Syntax.ParsedImplFileFragment: System.String ToString() FSharp.Compiler.Syntax.ParsedImplFileInput +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsExe +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsLastCompiland +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsScript +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsExe() +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsLastCompiland() +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsScript() FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_isScript() FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean isScript FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.ParsedImplFileInput NewParsedImplFileInput(System.String, Boolean, FSharp.Compiler.Syntax.QualifiedNameOfFile, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace], System.Tuple`2[System.Boolean,System.Boolean], FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia) +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_qualifiedNameOfFile() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile qualifiedNameOfFile +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia Trivia +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia get_Trivia() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia get_trivia() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia trivia FSharp.Compiler.Syntax.ParsedImplFileInput: Int32 Tag FSharp.Compiler.Syntax.ParsedImplFileInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] HashDirectives +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_HashDirectives() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_hashDirectives() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] hashDirectives +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_scopedPragmas() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] scopedPragmas -FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_modules() -FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] modules +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] Contents +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] contents +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_Contents() +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_contents() +FSharp.Compiler.Syntax.ParsedImplFileInput: System.String FileName FSharp.Compiler.Syntax.ParsedImplFileInput: System.String ToString() FSharp.Compiler.Syntax.ParsedImplFileInput: System.String fileName +FSharp.Compiler.Syntax.ParsedImplFileInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedImplFileInput: System.String get_fileName() -FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] get_isLastCompiland() -FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] isLastCompiland +FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] flags +FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] get_flags() FSharp.Compiler.Syntax.ParsedInput FSharp.Compiler.Syntax.ParsedInput+ImplFile: FSharp.Compiler.Syntax.ParsedImplFileInput Item FSharp.Compiler.Syntax.ParsedInput+ImplFile: FSharp.Compiler.Syntax.ParsedImplFileInput get_Item() @@ -5564,35 +5580,25 @@ FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput NewSigFil FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+ImplFile FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+SigFile FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+Tags +FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Text.Range Range FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Text.Range get_Range() FSharp.Compiler.Syntax.ParsedInput: Int32 Tag FSharp.Compiler.Syntax.ParsedInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedInput: System.String FileName FSharp.Compiler.Syntax.ParsedInput: System.String ToString() FSharp.Compiler.Syntax.ParsedInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedScriptInteraction -FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: FSharp.Compiler.Text.Range get_range() -FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleDecl] defns -FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleDecl] get_defns() -FSharp.Compiler.Syntax.ParsedScriptInteraction+HashDirective: FSharp.Compiler.Syntax.ParsedHashDirective get_hashDirective() -FSharp.Compiler.Syntax.ParsedScriptInteraction+HashDirective: FSharp.Compiler.Syntax.ParsedHashDirective hashDirective -FSharp.Compiler.Syntax.ParsedScriptInteraction+HashDirective: FSharp.Compiler.Text.Range get_range() -FSharp.Compiler.Syntax.ParsedScriptInteraction+HashDirective: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.ParsedScriptInteraction+Tags: Int32 Definitions -FSharp.Compiler.Syntax.ParsedScriptInteraction+Tags: Int32 HashDirective -FSharp.Compiler.Syntax.ParsedScriptInteraction: Boolean IsDefinitions -FSharp.Compiler.Syntax.ParsedScriptInteraction: Boolean IsHashDirective -FSharp.Compiler.Syntax.ParsedScriptInteraction: Boolean get_IsDefinitions() -FSharp.Compiler.Syntax.ParsedScriptInteraction: Boolean get_IsHashDirective() FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Syntax.ParsedScriptInteraction NewDefinitions(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleDecl], FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Syntax.ParsedScriptInteraction NewHashDirective(FSharp.Compiler.Syntax.ParsedHashDirective, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions -FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Syntax.ParsedScriptInteraction+HashDirective -FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Syntax.ParsedScriptInteraction+Tags +FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.ParsedScriptInteraction: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.ParsedScriptInteraction: Int32 Tag FSharp.Compiler.Syntax.ParsedScriptInteraction: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedScriptInteraction: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleDecl] defns +FSharp.Compiler.Syntax.ParsedScriptInteraction: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleDecl] get_defns() FSharp.Compiler.Syntax.ParsedScriptInteraction: System.String ToString() FSharp.Compiler.Syntax.ParsedSigFile FSharp.Compiler.Syntax.ParsedSigFile: FSharp.Compiler.Syntax.ParsedSigFile NewParsedSigFile(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedSigFileFragment]) @@ -5647,20 +5653,32 @@ FSharp.Compiler.Syntax.ParsedSigFileFragment: Int32 get_Tag() FSharp.Compiler.Syntax.ParsedSigFileFragment: System.String ToString() FSharp.Compiler.Syntax.ParsedSigFileInput FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.ParsedSigFileInput NewParsedSigFileInput(System.String, FSharp.Compiler.Syntax.QualifiedNameOfFile, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig], FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia) +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_qualifiedNameOfFile() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile qualifiedNameOfFile +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia Trivia +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia get_Trivia() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia get_trivia() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia trivia FSharp.Compiler.Syntax.ParsedSigFileInput: Int32 Tag FSharp.Compiler.Syntax.ParsedSigFileInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] HashDirectives +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_HashDirectives() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_hashDirectives() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] hashDirectives +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_scopedPragmas() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] scopedPragmas -FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_modules() -FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] modules +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] Contents +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] contents +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_Contents() +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_contents() +FSharp.Compiler.Syntax.ParsedSigFileInput: System.String FileName FSharp.Compiler.Syntax.ParsedSigFileInput: System.String ToString() FSharp.Compiler.Syntax.ParsedSigFileInput: System.String fileName +FSharp.Compiler.Syntax.ParsedSigFileInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedSigFileInput: System.String get_fileName() FSharp.Compiler.Syntax.ParserDetail FSharp.Compiler.Syntax.ParserDetail+Tags: Int32 ErrorRecovery @@ -5797,6 +5815,8 @@ FSharp.Compiler.Syntax.SynArgInfo: Microsoft.FSharp.Core.FSharpOption`1[FSharp.C FSharp.Compiler.Syntax.SynArgInfo: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident] ident FSharp.Compiler.Syntax.SynArgInfo: System.String ToString() FSharp.Compiler.Syntax.SynArgPats +FSharp.Compiler.Syntax.SynArgPats+NamePatPairs: FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia get_trivia() +FSharp.Compiler.Syntax.SynArgPats+NamePatPairs: FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia trivia FSharp.Compiler.Syntax.SynArgPats+NamePatPairs: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynArgPats+NamePatPairs: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynArgPats+NamePatPairs: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,FSharp.Compiler.Text.Range,FSharp.Compiler.Syntax.SynPat]] get_pats() @@ -5809,7 +5829,7 @@ FSharp.Compiler.Syntax.SynArgPats: Boolean IsNamePatPairs FSharp.Compiler.Syntax.SynArgPats: Boolean IsPats FSharp.Compiler.Syntax.SynArgPats: Boolean get_IsNamePatPairs() FSharp.Compiler.Syntax.SynArgPats: Boolean get_IsPats() -FSharp.Compiler.Syntax.SynArgPats: FSharp.Compiler.Syntax.SynArgPats NewNamePatPairs(Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,FSharp.Compiler.Text.Range,FSharp.Compiler.Syntax.SynPat]], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynArgPats: FSharp.Compiler.Syntax.SynArgPats NewNamePatPairs(Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,FSharp.Compiler.Text.Range,FSharp.Compiler.Syntax.SynPat]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia) FSharp.Compiler.Syntax.SynArgPats: FSharp.Compiler.Syntax.SynArgPats NewPats(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynPat]) FSharp.Compiler.Syntax.SynArgPats: FSharp.Compiler.Syntax.SynArgPats+NamePatPairs FSharp.Compiler.Syntax.SynArgPats: FSharp.Compiler.Syntax.SynArgPats+Pats @@ -7970,6 +7990,14 @@ FSharp.Compiler.Syntax.SynPat+IsInst: FSharp.Compiler.Syntax.SynType get_pat() FSharp.Compiler.Syntax.SynPat+IsInst: FSharp.Compiler.Syntax.SynType pat FSharp.Compiler.Syntax.SynPat+IsInst: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynPat+IsInst: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Syntax.SynPat get_lhsPat() +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Syntax.SynPat get_rhsPat() +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Syntax.SynPat lhsPat +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Syntax.SynPat rhsPat +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia get_trivia() +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia trivia +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynPat+ListCons: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynPat+LongIdent: FSharp.Compiler.Syntax.SynArgPats argPats FSharp.Compiler.Syntax.SynPat+LongIdent: FSharp.Compiler.Syntax.SynArgPats get_argPats() FSharp.Compiler.Syntax.SynPat+LongIdent: FSharp.Compiler.Syntax.SynLongIdent get_longDotId() @@ -8025,6 +8053,7 @@ FSharp.Compiler.Syntax.SynPat+Tags: Int32 DeprecatedCharRange FSharp.Compiler.Syntax.SynPat+Tags: Int32 FromParseError FSharp.Compiler.Syntax.SynPat+Tags: Int32 InstanceMember FSharp.Compiler.Syntax.SynPat+Tags: Int32 IsInst +FSharp.Compiler.Syntax.SynPat+Tags: Int32 ListCons FSharp.Compiler.Syntax.SynPat+Tags: Int32 LongIdent FSharp.Compiler.Syntax.SynPat+Tags: Int32 Named FSharp.Compiler.Syntax.SynPat+Tags: Int32 Null @@ -8059,6 +8088,7 @@ FSharp.Compiler.Syntax.SynPat: Boolean IsDeprecatedCharRange FSharp.Compiler.Syntax.SynPat: Boolean IsFromParseError FSharp.Compiler.Syntax.SynPat: Boolean IsInstanceMember FSharp.Compiler.Syntax.SynPat: Boolean IsIsInst +FSharp.Compiler.Syntax.SynPat: Boolean IsListCons FSharp.Compiler.Syntax.SynPat: Boolean IsLongIdent FSharp.Compiler.Syntax.SynPat: Boolean IsNamed FSharp.Compiler.Syntax.SynPat: Boolean IsNull @@ -8079,6 +8109,7 @@ FSharp.Compiler.Syntax.SynPat: Boolean get_IsDeprecatedCharRange() FSharp.Compiler.Syntax.SynPat: Boolean get_IsFromParseError() FSharp.Compiler.Syntax.SynPat: Boolean get_IsInstanceMember() FSharp.Compiler.Syntax.SynPat: Boolean get_IsIsInst() +FSharp.Compiler.Syntax.SynPat: Boolean get_IsListCons() FSharp.Compiler.Syntax.SynPat: Boolean get_IsLongIdent() FSharp.Compiler.Syntax.SynPat: Boolean get_IsNamed() FSharp.Compiler.Syntax.SynPat: Boolean get_IsNull() @@ -8099,6 +8130,7 @@ FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewDeprecatedCharRa FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewFromParseError(FSharp.Compiler.Syntax.SynPat, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewInstanceMember(FSharp.Compiler.Syntax.Ident, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewIsInst(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewListCons(FSharp.Compiler.Syntax.SynPat, FSharp.Compiler.Syntax.SynPat, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewLongIdent(FSharp.Compiler.Syntax.SynLongIdent, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynValTyparDecls], FSharp.Compiler.Syntax.SynArgPats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewNamed(FSharp.Compiler.Syntax.SynIdent, Boolean, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat NewNull(FSharp.Compiler.Text.Range) @@ -8119,6 +8151,7 @@ FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+DeprecatedCharRange FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+FromParseError FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+InstanceMember FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+IsInst +FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+ListCons FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+LongIdent FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+Named FSharp.Compiler.Syntax.SynPat: FSharp.Compiler.Syntax.SynPat+Null @@ -9363,15 +9396,22 @@ FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia: Microsoft.FSharp.Collecti FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.SyntaxTrivia.ConditionalDirectiveTrivia] get_ConditionalDirectives() FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia: System.String ToString() FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia: Void .ctor(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.SyntaxTrivia.ConditionalDirectiveTrivia], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.SyntaxTrivia.CommentTrivia]) +FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia +FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia: FSharp.Compiler.Text.Range ParenRange +FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia: FSharp.Compiler.Text.Range get_ParenRange() +FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia: System.String ToString() +FSharp.Compiler.SyntaxTrivia.SynArgPatsNamePatPairsTrivia: Void .ctor(FSharp.Compiler.Text.Range) FSharp.Compiler.SyntaxTrivia.SynBindingTrivia FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: FSharp.Compiler.SyntaxTrivia.SynBindingTrivia Zero FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: FSharp.Compiler.SyntaxTrivia.SynBindingTrivia get_Zero() FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] EqualsRange +FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] ExternKeyword FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] LetKeyword FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_EqualsRange() +FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_ExternKeyword() FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_LetKeyword() FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: System.String ToString() -FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range]) +FSharp.Compiler.SyntaxTrivia.SynBindingTrivia: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range]) FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia: FSharp.Compiler.Text.Range EqualsRange FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia: FSharp.Compiler.Text.Range get_EqualsRange() @@ -9517,6 +9557,11 @@ FSharp.Compiler.SyntaxTrivia.SynModuleSigDeclNestedModuleTrivia: Microsoft.FShar FSharp.Compiler.SyntaxTrivia.SynModuleSigDeclNestedModuleTrivia: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] get_ModuleKeyword() FSharp.Compiler.SyntaxTrivia.SynModuleSigDeclNestedModuleTrivia: System.String ToString() FSharp.Compiler.SyntaxTrivia.SynModuleSigDeclNestedModuleTrivia: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range]) +FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia +FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia: FSharp.Compiler.Text.Range ColonColonRange +FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia: FSharp.Compiler.Text.Range get_ColonColonRange() +FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia: System.String ToString() +FSharp.Compiler.SyntaxTrivia.SynPatListConsTrivia: Void .ctor(FSharp.Compiler.Text.Range) FSharp.Compiler.SyntaxTrivia.SynPatOrTrivia FSharp.Compiler.SyntaxTrivia.SynPatOrTrivia: FSharp.Compiler.Text.Range BarRange FSharp.Compiler.SyntaxTrivia.SynPatOrTrivia: FSharp.Compiler.Text.Range get_BarRange() diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.fs index 51de2a7a3ff..95d9db63cae 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.fs @@ -883,6 +883,7 @@ Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: System.String[] get_R Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: System.Version SystemRuntimeAssemblyVersion Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: System.Version get_SystemRuntimeAssemblyVersion() Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[System.String,System.Boolean]) +Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[System.String,System.Boolean], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.String[]]) Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: Void set_IsHostedExecution(Boolean) Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: Void set_IsInvalidationSupported(Boolean) Microsoft.FSharp.Core.CompilerServices.TypeProviderConfig: Void set_ReferencedAssemblies(System.String[]) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 2d24d2f678a..b871032a23b 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1128,7 +1128,7 @@ module rec Compiler = (sourceErrors, expectedErrors) ||> List.iter2 (fun actual expected -> - Assert.AreEqual(actual, expected, $"Mismatched error message:\nExpecting: {expected}\nActual: {actual}\n")) + Assert.AreEqual(expected, actual, $"Mismatched error message:\nExpecting: {expected}\nActual: {actual}\n")) let adjust (adjust: int) (result: CompilationResult) : CompilationResult = match result with @@ -1167,18 +1167,16 @@ module rec Compiler = withResults [expectedResult] result let withDiagnostics (expected: (ErrorType * Line * Col * Line * Col * string) list) (result: CompilationResult) : CompilationResult = - let (expectedResults: ErrorInfo list) = - expected |> - List.map( - fun e -> - let (error, (Line startLine), (Col startCol), (Line endLine), (Col endCol), message) = e + let expectedResults: ErrorInfo list = + [ for e in expected do + let (error, Line startLine, Col startCol, Line endLine, Col endCol, message) = e { Error = error Range = { StartLine = startLine StartColumn = startCol EndLine = endLine EndColumn = endCol } - Message = message }) + Message = message } ] withResults expectedResults result let withSingleDiagnostic (expected: (ErrorType * Line * Col * Line * Col * string)) (result: CompilationResult) : CompilationResult = diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index bbb2856344d..1679a74a336 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -683,58 +683,7 @@ Updated automatically, please check diffs in your pull request, changes must be exn |> Option.iter raise) static member ExecutionHasOutput(cmpl: Compilation, expectedOutput: string) = - CompilerAssert.Execute(cmpl, newProcess = true, onOutput = (fun output -> Assert.AreEqual(expectedOutput, output, sprintf "'%s' = '%s'" expectedOutput output))) - - /// Assert that the given source code compiles with the `defaultProjectOptions`, with no errors or warnings - static member CompileOfAst isExe source = - let outputFilePath = Path.ChangeExtension (tryCreateTemporaryFileName (), if isExe then "exe" else ".dll") - let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] } - - let parseResults = - checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) - |> Async.RunImmediate - - Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) - - let dependencies = - #if NETCOREAPP - Array.toList TargetFrameworkUtil.currentReferences - #else - [] - #endif - - let compileErrors, statusCode = - checker.Compile([parseResults.ParseTree], "test", outputFilePath, dependencies, executable = isExe, noframework = true) - |> Async.RunImmediate - - Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) - Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) - outputFilePath - - static member CompileOfAstToDynamicAssembly source = - let assemblyName = sprintf "test-%O" (Guid.NewGuid()) - let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] } - let parseResults = - checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) - |> Async.RunImmediate - - Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) - - let dependencies = - #if NETCOREAPP - Array.toList TargetFrameworkUtil.currentReferences - #else - [] - #endif - - let compileErrors, statusCode, assembly = - checker.CompileToDynamicAssembly([parseResults.ParseTree], assemblyName, dependencies, None, noframework = true) - |> Async.RunImmediate - - Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) - Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) - Assert.IsTrue(assembly.IsSome, "no assembly returned") - Option.get assembly + CompilerAssert.Execute(cmpl, newProcess = true, onOutput = (fun output -> Assert.AreEqual(expectedOutput, output, sprintf "'%s' = '%s'" expectedOutput output))) static member Pass (source: string) = let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunImmediate diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 18112cbc161..5410b2abb15 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -58,7 +58,6 @@ runtime; build; native; contentfiles; analyzers; buildtransitive - diff --git a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj index 7885ef99ad2..089b6a546c6 100644 --- a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj +++ b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj @@ -40,7 +40,6 @@ - + + + + + + + + diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj index 299bf973853..4bdb142e62b 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj @@ -27,8 +27,15 @@ - + + + + + + + + diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/ReferenceAssemblyTests.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/ReferenceAssemblyTests.fs index 8ed8ef5cb9c..9020c5d85e3 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/ReferenceAssemblyTests.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/ReferenceAssemblyTests.fs @@ -982,4 +982,35 @@ extends [runtime]System.Object } } """ ] + + [] + let ``Build .exe with --refonly ensure it produces a main in the ref assembly`` () = + FSharp """module ReferenceAssembly +open System + +Console.WriteLine("Hello World!")""" + |> withOptions ["--refonly"] + |> withName "HasMainCheck" + |> asExe + |> compile + |> shouldSucceed + |> verifyIL [ + referenceAssemblyAttributeExpectedIL + """.class private abstract auto ansi sealed ''.$ReferenceAssembly + extends [mscorlib]System.Object +{ + .method public static void main@() cil managed + { + .entrypoint + // Code size 2 (0x2) + .maxstack 8 + IL_0000: ldnull + IL_0001: throw + } // end of method $ReferenceAssembly::main@ + +} // end of class ''.$ReferenceAssembly +""" + ] + |> ignore + // TODO: Add tests for internal functions, types, interfaces, abstract types (with and without IVTs), (private, internal, public) fields, properties (+ different visibility for getters and setters), events. diff --git a/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs b/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs deleted file mode 100644 index 8f254fa03d5..00000000000 --- a/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs +++ /dev/null @@ -1,41 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.UnitTests.AstCompiler - -open FSharp.Test -open NUnit.Framework -open System.Reflection - -[] -module ``AST Compiler Smoke Tests`` = - - [] - let ``Simple E2E module compilation``() = - let assembly = - CompilerAssert.CompileOfAstToDynamicAssembly - """ -module TestModule - - let rec fib n = if n <= 1 then n else fib (n - 2) + fib (n - 1) -""" - - let method = assembly.GetType("TestModule").GetMethod("fib", BindingFlags.Static ||| BindingFlags.Public) - Assert.NotNull(method) - Assert.AreEqual(55, method.Invoke(null, [|10|])) - - [] - let ``Compile to Assembly``() = - let assembly = - CompilerAssert.CompileOfAst false - """ -module LiteralValue - -[] -let x = 7 -""" - - (ILVerifier assembly).VerifyIL [ - """ -.field public static literal int32 x = int32(0x00000007) - """ - ] \ No newline at end of file diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index b8e453bb1a5..e58ba939e76 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -95,7 +95,6 @@ - @@ -106,8 +105,7 @@ - + false @@ -119,7 +117,6 @@ - diff --git a/tests/fsharp/core/printing/output.1000.stdout.bsl b/tests/fsharp/core/printing/output.1000.stdout.bsl index 00b60931d99..71b706800bb 100644 --- a/tests/fsharp/core/printing/output.1000.stdout.bsl +++ b/tests/fsharp/core/printing/output.1000.stdout.bsl @@ -2765,7 +2765,7 @@ val ShortName: string = "hi" > val list2: int list = [1] module FSI_0317. - D27805741a339047ef3ed7a2ca8faae3c17e6ef2371984011e49a6c9c3286641 + C6f6ae524efb4d95b2b2eaa363022f9d4a28c777f788498ca81a55b9ec1aad1a {"ImmutableField0":6} type R1 = diff --git a/tests/fsharp/core/printing/output.200.stdout.bsl b/tests/fsharp/core/printing/output.200.stdout.bsl index 2c12e25b197..ad24f0b8ff0 100644 --- a/tests/fsharp/core/printing/output.200.stdout.bsl +++ b/tests/fsharp/core/printing/output.200.stdout.bsl @@ -2010,7 +2010,7 @@ val ShortName: string = "hi" > val list2: int list = [1] module FSI_0317. - D27805741a339047ef3ed7a2ca8faae3c17e6ef2371984011e49a6c9c3286641 + C6f6ae524efb4d95b2b2eaa363022f9d4a28c777f788498ca81a55b9ec1aad1a {"ImmutableField0":6} type R1 = diff --git a/tests/fsharp/core/printing/output.multiemit.stdout.bsl b/tests/fsharp/core/printing/output.multiemit.stdout.bsl index 4b00548df81..ef51dfc4078 100644 --- a/tests/fsharp/core/printing/output.multiemit.stdout.bsl +++ b/tests/fsharp/core/printing/output.multiemit.stdout.bsl @@ -6312,7 +6312,7 @@ val ShortName: string = "hi" > val list2: int list = [1] module FSI_0316. - D27805741a339047ef3ed7a2ca8faae3c17e6ef2371984011e49a6c9c3286641 + C6f6ae524efb4d95b2b2eaa363022f9d4a28c777f788498ca81a55b9ec1aad1a {"ImmutableField0":6} type R1 = diff --git a/tests/fsharp/core/printing/output.off.stdout.bsl b/tests/fsharp/core/printing/output.off.stdout.bsl index f9c6d893f87..234cfc2e4fd 100644 --- a/tests/fsharp/core/printing/output.off.stdout.bsl +++ b/tests/fsharp/core/printing/output.off.stdout.bsl @@ -1779,7 +1779,7 @@ val ShortName: string = "hi" > val list2: int list module FSI_0317. - D27805741a339047ef3ed7a2ca8faae3c17e6ef2371984011e49a6c9c3286641 + C6f6ae524efb4d95b2b2eaa363022f9d4a28c777f788498ca81a55b9ec1aad1a {"ImmutableField0":6} type R1 = diff --git a/tests/fsharp/core/printing/output.stdout.bsl b/tests/fsharp/core/printing/output.stdout.bsl index 4b00548df81..ef51dfc4078 100644 --- a/tests/fsharp/core/printing/output.stdout.bsl +++ b/tests/fsharp/core/printing/output.stdout.bsl @@ -6312,7 +6312,7 @@ val ShortName: string = "hi" > val list2: int list = [1] module FSI_0316. - D27805741a339047ef3ed7a2ca8faae3c17e6ef2371984011e49a6c9c3286641 + C6f6ae524efb4d95b2b2eaa363022f9d4a28c777f788498ca81a55b9ec1aad1a {"ImmutableField0":6} type R1 = diff --git a/tests/fsharp/regression/13219/test.fsx b/tests/fsharp/regression/13219/test.fsx new file mode 100644 index 00000000000..c6ff7817805 --- /dev/null +++ b/tests/fsharp/regression/13219/test.fsx @@ -0,0 +1,22 @@ +#r "nuget: FSharp.Data, 4.2.10" + +open FSharp.Data + +[] +let url = "https://en.wikipedia.org/wiki/F_Sharp_(programming_language)" + +// Works +let html = new HtmlProvider() + +type System.Object with + + // Works + member x.Html1 = new HtmlProvider<"https://en.wikipedia.org/wiki/F_Sharp_(programming_language)">() + + // Error: FS0267 This is not a valid constant expression or custom attribute value + member x.Html2 = new HtmlProvider() + +// This is a compilation test, not a lot actually happens in the test +do (System.Console.Out.WriteLine "Test Passed"; + System.IO.File.WriteAllText("test.ok", "ok"); + exit 0) diff --git a/tests/fsharp/regression/13710/test.fsx b/tests/fsharp/regression/13710/test.fsx new file mode 100644 index 00000000000..e80a3ecd54b --- /dev/null +++ b/tests/fsharp/regression/13710/test.fsx @@ -0,0 +1,17 @@ +// See https://github.com/dotnet/fsharp/issues/13710 +// +// Note FSharp.Data 5.0.1 is split into two packages, where the type providers depend on FSharp.Data.Core +// +// The TypeProviderCOnfig reported to the type providers must contain both FSharp.Data and FSharp.Data.Core. +#r "nuget: FSharp.Data, 5.0.1" + +open FSharp.Data +type Auth = JsonProvider<"""{ "test": 1 }"""> +let auth = Auth.Parse("""{ "test": 1 }""") +printfn $"{auth.Test}" + +// This is a compilation test, not a lot actually happens in the test +do (System.Console.Out.WriteLine "Test Passed"; + System.IO.File.WriteAllText("test.ok", "ok"); + exit 0) + diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index c40d9f756e6..e1ec4ad346d 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2157,11 +2157,17 @@ module RegressionTests = [] let ``12383-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/12383" FSC_OPTIMIZED + [] + let ``13219-bug-FSI`` () = singleTestBuildAndRun "regression/13219" FSI + [] let ``4715-optimized`` () = let cfg = testConfig "regression/4715" fsc cfg "%s -o:test.exe --optimize+" cfg.fsc_flags ["date.fs"; "env.fs"; "main.fs"] + [] + let ``multi-package-type-provider-test-FSI`` () = singleTestBuildAndRun "regression/13710" FSI + #if NETCOREAPP [] let ``Large inputs 12322 fsc.dll 64-bit fsc.dll .NET SDK generating optimized code`` () = @@ -2583,6 +2589,21 @@ module TypecheckTests = peverify cfg "pos40.exe" exec cfg ("." ++ "pos40.exe") "" + [] + let ``sigs pos1281`` () = + let cfg = testConfig "typecheck/sigs" + // This checks that warning 25 "incomplete matches" is not triggered + fsc cfg "%s --target:exe -o:pos1281.exe --warnaserror --nowarn:26" cfg.fsc_flags ["pos1281.fs"] + peverify cfg "pos1281.exe" + exec cfg ("." ++ "pos1281.exe") "" + + [] + let ``sigs pos3294`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:exe -o:pos3294.exe --warnaserror" cfg.fsc_flags ["pos3294.fs"] + peverify cfg "pos3294.exe" + exec cfg ("." ++ "pos3294.exe") "" + [] let ``sigs pos23`` () = let cfg = testConfig "typecheck/sigs" @@ -3400,29 +3421,29 @@ module GeneratedSignatureTests = [] module OverloadResolution = module ``fsharpqa migrated tests`` = - let [] ``Conformance\Expressions\SyntacticSugar (E_Slices01.fs)`` () = singleNegTest (testConfig "conformance/expressions/syntacticsugar") "E_Slices01" - let [] ``Conformance\Expressions\Type-relatedExpressions (E_RigidTypeAnnotation03.fsx)`` () = singleNegTest (testConfig "conformance/expressions/type-relatedexpressions") "E_RigidTypeAnnotation03" - let [] ``Conformance\Inference (E_OneTypeVariable03.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_OneTypeVariable03" - let [] ``Conformance\Inference (E_OneTypeVariable03rec.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_OneTypeVariable03rec" - let [] ``Conformance\Inference (E_TwoDifferentTypeVariablesGen00.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariablesGen00" - let [] ``Conformance\Inference (E_TwoDifferentTypeVariables01.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariables01" - let [] ``Conformance\Inference (E_TwoDifferentTypeVariables01rec.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariables01rec" - let [] ``Conformance\Inference (E_TwoDifferentTypeVariablesGen00rec.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariablesGen00rec" - let [] ``Conformance\Inference (E_TwoEqualTypeVariables02.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoEqualTypeVariables02" - let [] ``Conformance\Inference (E_TwoEqualYypeVariables02rec.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoEqualYypeVariables02rec" - let [] ``Conformance\Inference (E_LeftToRightOverloadResolution01.fs)`` () = singleNegTest (testConfig "conformance/inference") "E_LeftToRightOverloadResolution01" - let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass01.fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass01" - let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass03.fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass03" - let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass04.fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass04" + let [] ``Conformance\Expressions\SyntacticSugar (E_Slices01_fs)`` () = singleNegTest (testConfig "conformance/expressions/syntacticsugar") "E_Slices01" + let [] ``Conformance\Expressions\Type-relatedExpressions (E_RigidTypeAnnotation03_fsx)`` () = singleNegTest (testConfig "conformance/expressions/type-relatedexpressions") "E_RigidTypeAnnotation03" + let [] ``Conformance\Inference (E_OneTypeVariable03_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_OneTypeVariable03" + let [] ``Conformance\Inference (E_OneTypeVariable03rec_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_OneTypeVariable03rec" + let [] ``Conformance\Inference (E_TwoDifferentTypeVariablesGen00_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariablesGen00" + let [] ``Conformance\Inference (E_TwoDifferentTypeVariables01_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariables01" + let [] ``Conformance\Inference (E_TwoDifferentTypeVariables01rec_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariables01rec" + let [] ``Conformance\Inference (E_TwoDifferentTypeVariablesGen00rec_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoDifferentTypeVariablesGen00rec" + let [] ``Conformance\Inference (E_TwoEqualTypeVariables02_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoEqualTypeVariables02" + let [] ``Conformance\Inference (E_TwoEqualYypeVariables02rec_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_TwoEqualYypeVariables02rec" + let [] ``Conformance\Inference (E_LeftToRightOverloadResolution01_fs)`` () = singleNegTest (testConfig "conformance/inference") "E_LeftToRightOverloadResolution01" + let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass01_fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass01" + let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass03_fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass03" + let [] ``Conformance\WellFormedness (E_Clashing_Values_in_AbstractClass04_fs)`` () = singleNegTest (testConfig "conformance/wellformedness") "E_Clashing_Values_in_AbstractClass04" // note: this test still exist in fsharpqa to assert the compiler doesn't crash // the part of the code generating a flaky error due to https://github.com/dotnet/fsharp/issues/6725 // is elided here to focus on overload resolution error messages - let [] ``Conformance\LexicalAnalysis\SymbolicOperators (E_LessThanDotOpenParen001.fs)`` () = singleNegTest (testConfig "conformance/lexicalanalysis") "E_LessThanDotOpenParen001" + let [] ``Conformance\LexicalAnalysis\SymbolicOperators (E_LessThanDotOpenParen001_fs)`` () = singleNegTest (testConfig "conformance/lexicalanalysis") "E_LessThanDotOpenParen001" module ``error messages using BCL``= - let [] ``neg_System.Convert.ToString.OverloadList``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Convert.ToString.OverloadList" - let [] ``neg_System.Threading.Tasks.Task.Run.OverloadList``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Threading.Tasks.Task.Run.OverloadList" - let [] ``neg_System.Drawing.Graphics.DrawRectangleOverloadList.fsx``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Drawing.Graphics.DrawRectangleOverloadList" + let [] ``neg_System_Convert_ToString_OverloadList``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Convert.ToString.OverloadList" + let [] ``neg_System_Threading_Tasks_Task_Run_OverloadList``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Threading.Tasks.Task.Run.OverloadList" + let [] ``neg_System_Drawing_Graphics_DrawRectangleOverloadList_fsx``() = singleNegTest (testConfig "typecheck/overloads") "neg_System.Drawing.Graphics.DrawRectangleOverloadList" module ``ad hoc code overload error messages``= let [] ``neg_many_many_overloads`` () = singleNegTest (testConfig "typecheck/overloads") "neg_many_many_overloads" diff --git a/tests/fsharp/typecheck/sigs/neg10.bsl b/tests/fsharp/typecheck/sigs/neg10.bsl index 40a58bfb096..ca47dbf94d0 100644 --- a/tests/fsharp/typecheck/sigs/neg10.bsl +++ b/tests/fsharp/typecheck/sigs/neg10.bsl @@ -245,5 +245,3 @@ neg10.fs(455,25,455,26): typecheck error FS0001: The type 'C' does not support a neg10.fs(456,24,456,25): typecheck error FS0001: The type 'C' does not support a conversion to the type 'int64' neg10.fs(457,26,457,27): typecheck error FS0001: The type 'C' does not support a conversion to the type 'decimal' - -neg10.fsi(1,1,1,1): typecheck error FS0240: The signature file 'Neg10' does not have a corresponding implementation file. If an implementation file exists then check the 'module' and 'namespace' declarations in the signature and implementation files match. diff --git a/tests/fsharp/typecheck/sigs/neg20.bsl b/tests/fsharp/typecheck/sigs/neg20.bsl index 6fe2d2e3295..88f483967e4 100644 --- a/tests/fsharp/typecheck/sigs/neg20.bsl +++ b/tests/fsharp/typecheck/sigs/neg20.bsl @@ -271,7 +271,7 @@ neg20.fs(216,5,216,12): typecheck error FS0842: This attribute is not valid for neg20.fs(219,5,219,15): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(222,5,222,24): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(222,5,222,31): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(225,5,225,22): typecheck error FS0842: This attribute is not valid for use on this language element @@ -289,9 +289,9 @@ neg20.fs(243,5,243,23): typecheck error FS0842: This attribute is not valid for neg20.fs(249,9,249,27): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(255,5,255,21): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(255,5,255,28): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(258,5,258,31): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(258,5,258,38): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(261,5,261,17): typecheck error FS0842: This attribute is not valid for use on this language element @@ -299,7 +299,7 @@ neg20.fs(265,5,265,24): typecheck error FS0842: This attribute is not valid for neg20.fs(268,5,268,27): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(271,5,271,13): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(271,5,271,15): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(278,14,278,95): typecheck error FS0507: No accessible member or object constructor named 'ProcessStartInfo' takes 0 arguments. Note the call to this member also provides 2 named arguments. diff --git a/tests/fsharp/typecheck/sigs/neg31.bsl b/tests/fsharp/typecheck/sigs/neg31.bsl index 86bb626f0b4..9140452d235 100644 --- a/tests/fsharp/typecheck/sigs/neg31.bsl +++ b/tests/fsharp/typecheck/sigs/neg31.bsl @@ -1,12 +1,12 @@ -neg31.fs(9,6,9,30): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(9,6,9,64): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. -neg31.fs(71,12,71,36): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(71,12,71,70): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. -neg31.fs(107,13,107,41): typecheck error FS1200: The attribute 'CLSCompliantAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(107,13,107,48): typecheck error FS1200: The attribute 'CLSCompliantAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. -neg31.fs(28,6,28,30): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(28,6,28,64): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. -neg31.fs(93,14,93,42): typecheck error FS1200: The attribute 'CLSCompliantAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(93,14,93,49): typecheck error FS1200: The attribute 'CLSCompliantAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. -neg31.fs(47,6,47,30): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. +neg31.fs(47,6,47,64): typecheck error FS1200: The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ. Only the attribute from the signature will be included in the compiled code. diff --git a/tests/fsharp/typecheck/sigs/neg32.bsl b/tests/fsharp/typecheck/sigs/neg32.bsl index bb849961393..be532860a7a 100644 --- a/tests/fsharp/typecheck/sigs/neg32.bsl +++ b/tests/fsharp/typecheck/sigs/neg32.bsl @@ -1,44 +1,50 @@ -neg32.fs(17,21,17,49): typecheck error FS0842: This attribute is not valid for use on this language element +neg32.fs(17,11,17,56): typecheck error FS0842: This attribute is not valid for use on this language element neg32.fs(24,15,24,16): typecheck error FS0043: The member or object constructor 'TryParse' does not take 1 argument(s). An overload was found taking 2 arguments. -neg32.fs(39,17,39,19): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(43,17,43,19): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(40,4,40,23): typecheck error FS0671: A property cannot have explicit type parameters. Consider using a method instead. +neg32.fs(44,4,44,23): typecheck error FS0671: A property cannot have explicit type parameters. Consider using a method instead. -neg32.fs(40,21,40,23): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(44,21,44,23): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(41,21,41,23): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(45,21,45,23): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(41,27,41,29): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(45,27,45,29): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(42,18,42,20): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(46,18,46,20): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(42,24,42,26): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(46,24,46,26): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(46,17,46,19): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(50,17,50,19): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(47,4,47,23): typecheck error FS0671: A property cannot have explicit type parameters. Consider using a method instead. +neg32.fs(51,4,51,23): typecheck error FS0671: A property cannot have explicit type parameters. Consider using a method instead. -neg32.fs(47,21,47,23): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(51,21,51,23): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(48,21,48,23): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(52,21,52,23): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(48,27,48,29): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(52,27,52,29): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(49,18,49,20): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(53,18,53,20): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(49,24,49,26): typecheck error FS0039: The type parameter 'U is not defined. +neg32.fs(53,24,53,26): typecheck error FS0039: The type parameter 'U is not defined. -neg32.fs(52,10,52,12): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(54,18,54,20): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(52,10,52,12): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(55,18,55,20): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(55,11,55,13): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(56,18,56,20): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(55,11,55,13): typecheck error FS0039: The type parameter 'T is not defined. +neg32.fs(59,10,59,12): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(59,65,59,86): typecheck error FS0033: The non-generic type 'System.EventArgs' does not expect any type arguments, but here is given 1 type argument(s) +neg32.fs(59,10,59,12): typecheck error FS0039: The type parameter 'T is not defined. -neg32.fs(59,21,59,27): typecheck error FS1091: The event 'Event1' has a non-standard type. If this event is declared in another CLI language, you may need to access this event using the explicit add_Event1 and remove_Event1 methods for the event. If this event is declared in F#, make the type of the event an instantiation of either 'IDelegateEvent<_>' or 'IEvent<_,_>'. +neg32.fs(62,11,62,13): typecheck error FS0039: The type parameter 'T is not defined. + +neg32.fs(62,11,62,13): typecheck error FS0039: The type parameter 'T is not defined. + +neg32.fs(66,65,66,86): typecheck error FS0033: The non-generic type 'System.EventArgs' does not expect any type arguments, but here is given 1 type argument(s) + +neg32.fs(66,21,66,27): typecheck error FS1091: The event 'Event1' has a non-standard type. If this event is declared in another CLI language, you may need to access this event using the explicit add_Event1 and remove_Event1 methods for the event. If this event is declared in F#, make the type of the event an instantiation of either 'IDelegateEvent<_>' or 'IEvent<_,_>'. diff --git a/tests/fsharp/typecheck/sigs/neg32.fs b/tests/fsharp/typecheck/sigs/neg32.fs index 4ff91d11dcf..a8893b86bbe 100644 --- a/tests/fsharp/typecheck/sigs/neg32.fs +++ b/tests/fsharp/typecheck/sigs/neg32.fs @@ -34,7 +34,11 @@ type PositiveClass<'A>() = abstract M<'T> : 'T -> 'T abstract M2<'T> : 'T -> 'A abstract M : 'U -> 'U - + abstract M3 : 'A with get, set + abstract M4 : 'A with set + abstract M5 : 'A with get + + type NegativeInterface = abstract v : 'T abstract M<'T> : 'U @@ -47,6 +51,9 @@ type NegativeClass() = abstract M<'T> : 'U abstract M<'T> : 'U -> 'U abstract M : ('U -> 'U) + abstract M2 : 'T with get, set + abstract M3 : 'T with set + abstract M4 : 'T with get type NegativeRecord = { v : 'T } diff --git a/tests/fsharp/typecheck/sigs/pos1281.fs b/tests/fsharp/typecheck/sigs/pos1281.fs new file mode 100644 index 00000000000..f2a73c07c3d --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos1281.fs @@ -0,0 +1,17 @@ +module Pos1281 + +type Cond = Foo | Bar | Baz +let (|SetV|) x _ = x + +let c = Cond.Foo + +match c with +| Baz -> + printfn "Baz" +| Foo & SetV "and" kwd +| Bar & SetV "or" kwd -> + printfn "Keyword: %s" kwd +| Baz -> failwith "wat" + +printfn "test completed" +exit 0 diff --git a/tests/fsharp/typecheck/sigs/pos3294.fs b/tests/fsharp/typecheck/sigs/pos3294.fs new file mode 100644 index 00000000000..55fc5f2631b --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos3294.fs @@ -0,0 +1,8 @@ +module Pos40 + +let f = function + | [] -> 0 + | (_ :: _) & _ -> 0 + +printfn "test completed" +exit 0 diff --git a/tests/fsharp/typecheck/sigs/version50/neg20.bsl b/tests/fsharp/typecheck/sigs/version50/neg20.bsl index b1e3b87ffb5..37e8f71a499 100644 --- a/tests/fsharp/typecheck/sigs/version50/neg20.bsl +++ b/tests/fsharp/typecheck/sigs/version50/neg20.bsl @@ -319,7 +319,7 @@ neg20.fs(216,5,216,12): typecheck error FS0842: This attribute is not valid for neg20.fs(219,5,219,15): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(222,5,222,24): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(222,5,222,31): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(225,5,225,22): typecheck error FS0842: This attribute is not valid for use on this language element @@ -337,9 +337,9 @@ neg20.fs(243,5,243,23): typecheck error FS0842: This attribute is not valid for neg20.fs(249,9,249,27): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(255,5,255,21): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(255,5,255,28): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(258,5,258,31): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(258,5,258,38): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(261,5,261,17): typecheck error FS0842: This attribute is not valid for use on this language element @@ -347,7 +347,7 @@ neg20.fs(265,5,265,24): typecheck error FS0842: This attribute is not valid for neg20.fs(268,5,268,27): typecheck error FS0842: This attribute is not valid for use on this language element -neg20.fs(271,5,271,13): typecheck error FS0842: This attribute is not valid for use on this language element +neg20.fs(271,5,271,15): typecheck error FS0842: This attribute is not valid for use on this language element neg20.fs(278,14,278,95): typecheck error FS0507: No accessible member or object constructor named 'ProcessStartInfo' takes 0 arguments. Note the call to this member also provides 2 named arguments. diff --git a/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fs b/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fs index ceeadc93274..082ea859d45 100644 --- a/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fs +++ b/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fs @@ -1,6 +1,6 @@ // #Conformance #SignatureFiles #Attributes #Regression // Regression for 6446 - verifying spec matches implementation when fs/fsi files attributes differ -//The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ\. Only the attribute from the signature will be included in the compiled code\. +//The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ\. Only the attribute from the signature will be included in the compiled code\. module M diff --git a/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fsi b/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fsi index b3092d384b2..8f6e9113446 100644 --- a/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fsi +++ b/tests/fsharpqa/Source/Conformance/Signatures/SignatureConformance/AttributeMatching01.fsi @@ -1,6 +1,6 @@ // #Conformance #SignatureFiles #Attributes #Regression // Regression for 6446 - verifying spec matches implementation when fs/fsi files attributes differ -//The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ\. Only the attribute from the signature will be included in the compiled code\. +//The attribute 'ObsoleteAttribute' appears in both the implementation and the signature, but the attribute arguments differ\. Only the attribute from the signature will be included in the compiled code\. module M diff --git a/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry01.fs b/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry01.fs index d78d7ba06da..bebbbf4bbc5 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry01.fs +++ b/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry01.fs @@ -1,6 +1,6 @@ // #Regression #Diagnostics // Regression test for FSHARP1.0:1980 -//Object constructors cannot directly use try/with and try/finally prior to the initialization of the object\. This includes constructs such as 'for x in \.\.\.' that may elaborate to uses of these constructs\. This is a limitation imposed by Common IL\.$ +// #light type X = class diff --git a/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry02.fs b/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry02.fs index 1baff095c07..b1510fbf1a6 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry02.fs +++ b/tests/fsharpqa/Source/Diagnostics/General/E_ObjectConstructorAndTry02.fs @@ -1,6 +1,6 @@ // #Regression #Diagnostics // Regression test for FSHARP1.0:1980 -//Object constructors cannot directly use try/with and try/finally prior to the initialization of the object\. This includes constructs such as 'for x in \.\.\.' that may elaborate to uses of these constructs\. This is a limitation imposed by Common IL\.$ +// #light type X = struct diff --git a/tests/fsharpqa/Source/Misc/E_CompiledName.fs b/tests/fsharpqa/Source/Misc/E_CompiledName.fs index cdf5e84ae72..437032e0112 100644 --- a/tests/fsharpqa/Source/Misc/E_CompiledName.fs +++ b/tests/fsharpqa/Source/Misc/E_CompiledName.fs @@ -1,8 +1,8 @@ // #Regression #Misc // Regression test for FSHARP1.0:5936 // This test ensures that you can't apply the CompiledName attribute more than once to a property -//The attribute type 'CompiledNameAttribute' has 'AllowMultiple=false'\. Multiple instances of this attribute cannot be attached to a single language element\.$ -//The attribute type 'CompiledNameAttribute' has 'AllowMultiple=false'\. Multiple instances of this attribute cannot be attached to a single language element\.$ +//The attribute type 'CompiledNameAttribute' has 'AllowMultiple=false'\. Multiple instances of this attribute cannot be attached to a single language element\.$ +//The attribute type 'CompiledNameAttribute' has 'AllowMultiple=false'\. Multiple instances of this attribute cannot be attached to a single language element\.$ module M type T() = diff --git a/tests/service/Common.fs b/tests/service/Common.fs index fe50b7b5a8e..e19ed1f1c49 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -210,7 +210,7 @@ let matchBraces (name: string, code: string) = let getSingleModuleLikeDecl (input: ParsedInput) = match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ decl ])) -> decl + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ decl ])) -> decl | _ -> failwith "Could not get module decls" let getSingleModuleMemberDecls (input: ParsedInput) = @@ -232,6 +232,11 @@ let getSingleParenInnerExpr expr = | SynModuleDecl.Expr(SynExpr.Paren(expr, _, _, _), _) -> expr | _ -> failwith "Unexpected tree" +let getLetDeclHeadPattern (moduleDecl: SynModuleDecl) = + match moduleDecl with + | SynModuleDecl.Let(_, [SynBinding(headPat = pat)], _) -> pat + | _ -> failwith "Unexpected tree" + let parseSourceCodeAndGetModule (source: string) = parseSourceCode ("test.fsx", source) |> getSingleModuleLikeDecl @@ -458,7 +463,7 @@ let coreLibAssemblyName = "mscorlib" #endif -let getRange (e: SynExpr) = e.Range +let inline getRange (node: ^T) = (^T: (member Range: range) node) let assertRange (expectedStartLine: int, expectedStartColumn: int) diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index ac208f8f6a3..d8494d490ed 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -54,7 +54,7 @@ let internal identsAndRanges (input: ParsedInput) = (identAndRange (longIdentToString longIdent) (longIdent |> List.map (fun id -> id.idRange) |> List.reduce unionRanges)) :: xs match input with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = modulesOrNamespaces)) -> + | ParsedInput.ImplFile(ParsedImplFileInput(contents = modulesOrNamespaces)) -> modulesOrNamespaces |> List.collect extractFromModuleOrNamespace | ParsedInput.SigFile _ -> [] diff --git a/tests/service/ParserTests.fs b/tests/service/ParserTests.fs index b96083b77e7..cc4a9923ab7 100644 --- a/tests/service/ParserTests.fs +++ b/tests/service/ParserTests.fs @@ -131,9 +131,7 @@ match () with match getSingleExprInModule parseResults with | SynExpr.Match (clauses=[ SynMatchClause (pat=pat) ]) -> match pat with - | SynPat.Or - (SynPat.FromParseError (SynPat.Paren (SynPat.FromParseError (SynPat.Wild _, _), _), _), - SynPat.Named _, _, _) -> () + | SynPat.Paren(SynPat.Or(SynPat.Tuple(_, [SynPat.Named _; SynPat.Wild _], _), SynPat.Named _, _, _), _) -> () | _ -> failwith "Unexpected pattern" | _ -> failwith "Unexpected tree" @@ -185,7 +183,7 @@ let f (x, match getSingleDeclInModule parseResults with | SynModuleDecl.Let (_, [ SynBinding (headPat = SynPat.LongIdent (argPats = SynArgPats.Pats [ pat ])) ], _) -> match pat with - | SynPat.FromParseError (SynPat.Paren (SynPat.FromParseError (SynPat.Wild _, _), _), _) -> () + | SynPat.FromParseError (SynPat.Paren (SynPat.Tuple(_, [SynPat.Named _; SynPat.Wild _], _), _), _) -> () | _ -> failwith "Unexpected tree" | _ -> failwith "Unexpected tree" @@ -194,7 +192,11 @@ let assertIsBefore (f: _ -> range) (a, b) = let r2 = f b Position.posGeq r2.Start r1.End |> shouldEqual true -let checkExprOrder exprs = +let inline assertIsEmptyRange node = + let range = getRange node + Position.posEq range.Start range.End |> shouldEqual true + +let inline checkNodeOrder exprs = exprs |> List.pairwise |> List.iter (assertIsBefore getRange) @@ -220,7 +222,7 @@ let ``Expr - Tuple 01`` () = | [ SynExpr.Tuple(_, [SynExpr.ArbitraryAfterError _ as e11; SynExpr.ArbitraryAfterError _ as e12], c1, _) SynExpr.Tuple(_, [SynExpr.ArbitraryAfterError _ as e21; SynExpr.ArbitraryAfterError _ as e22; SynExpr.ArbitraryAfterError _ as e23], c2, _) SynExpr.Tuple(_, [SynExpr.ArbitraryAfterError _ as e31; SynExpr.ArbitraryAfterError _ as e32; SynExpr.ArbitraryAfterError _ as e33; SynExpr.ArbitraryAfterError _ as e34], c3, _) ] -> - [ e11; e12; e21; e22; e23; e31; e32; e33; e34 ] |> checkExprOrder + [ e11; e12; e21; e22; e23; e31; e32; e33; e34 ] |> checkNodeOrder [ c1, 1; c2, 2; c3, 3 ] |> checkRangeCountAndOrder | _ -> failwith "Unexpected tree" @@ -237,7 +239,7 @@ let ``Expr - Tuple 02`` () = | [ SynExpr.Tuple(_, [SynExpr.Const _ as e11; SynExpr.ArbitraryAfterError _ as e12], c1, _) SynExpr.Tuple(_, [SynExpr.ArbitraryAfterError _ as e21; SynExpr.Const _ as e22], c2, _) SynExpr.Tuple(_, [SynExpr.Const _ as e31; SynExpr.Const _ as e32], c3, _) ] -> - [ e11; e12; e21; e22; e31; e32 ] |> checkExprOrder + [ e11; e12; e21; e22; e31; e32 ] |> checkNodeOrder [ c1, 1; c2, 1; c3, 1 ] |> checkRangeCountAndOrder | _ -> failwith "Unexpected tree" @@ -269,7 +271,7 @@ let ``Expr - Tuple 03`` () = [ e11; e12; e13; e21; e22; e23; e31; e32; e33 e41; e42; e43; e51; e52; e53; e61; e62; e63 e71; e72; e73 ] - |> checkExprOrder + |> checkNodeOrder [ c1, 2; c2, 2; c3, 2 c4, 2; c5, 2; c6, 2 @@ -294,9 +296,7 @@ let ``Expr - Tuple 04`` () = SynExpr.ArbitraryAfterError _ as e6 SynExpr.Const _ as e7 SynExpr.ArbitraryAfterError _ as e8 ], c, _) ] -> - [ e1; e2; e3; e4; e5; e6; e7; e8 ] - |> checkExprOrder - + [ e1; e2; e3; e4; e5; e6; e7; e8 ] |> checkNodeOrder [ c, 7 ] |> checkRangeCountAndOrder | _ -> failwith "Unexpected tree" @@ -333,3 +333,138 @@ let x = 1, shouldEqual expr.Range.StartLine expr.Range.EndLine shouldEqual range.StartLine range.EndLine | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Head - Tuple 01`` () = + let parseResults = getParseResults """ +let , = () +let ,, = () +let ,,, = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map getLetDeclHeadPattern + match pats with + | [ SynPat.Tuple(_, [SynPat.Wild _ as p11; SynPat.Wild _ as p12], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Wild _ as p22; SynPat.Wild _ as p23], _) + SynPat.Tuple(_, [SynPat.Wild _ as p31; SynPat.Wild _ as p32; SynPat.Wild _ as p33; SynPat.Wild _ as p34], _) ] -> + [ p11; p12; p21; p22; p23; p31; p32; p33; p34 ] |> checkNodeOrder + [ p11; p12; p21; p22; p23; p31; p32; p33; p34 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Head - Tuple 02`` () = + let parseResults = getParseResults """ +let 1, = () +let ,1 = () +let 1,1 = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map getLetDeclHeadPattern + match pats with + | [ SynPat.Tuple(_, [SynPat.Const _ as p11; SynPat.Wild _ as p12], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Const _ as p22], _) + SynPat.Tuple(_, [SynPat.Const _ as p31; SynPat.Const _ as p32], _) ] -> + [ p11; p12; p21; p22; p31; p32 ] |> checkNodeOrder + [ p12; p21 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Head - Tuple 03`` () = + let parseResults = getParseResults """ +let 1,, = () +let ,1, = () +let ,,1 = () + +let 1,1, = () +let ,1,1 = () +let 1,,1 = () + +let 1,1,1 = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map getLetDeclHeadPattern + match pats with + | [ SynPat.Tuple(_, [SynPat.Const _ as p11; SynPat.Wild _ as p12; SynPat.Wild _ as p13], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Const _ as p22; SynPat.Wild _ as p23], _) + SynPat.Tuple(_, [SynPat.Wild _ as p31; SynPat.Wild _ as p32; SynPat.Const _ as p33], _) + + SynPat.Tuple(_, [SynPat.Const _ as p41; SynPat.Const _ as p42; SynPat.Wild _ as p43], _) + SynPat.Tuple(_, [SynPat.Wild _ as p51; SynPat.Const _ as p52; SynPat.Const _ as p53], _) + SynPat.Tuple(_, [SynPat.Const _ as p61; SynPat.Wild _ as p62; SynPat.Const _ as p63], _) + + SynPat.Tuple(_, [SynPat.Const _ as p71; SynPat.Const _ as p72; SynPat.Const _ as p73], _) ] -> + [ p11; p12; p13; p21; p22; p23; p31; p32; p33 + p41; p42; p43; p51; p52; p53; p61; p62; p63 + p71; p72; p73 ] |> checkNodeOrder + [ p12; p13; p21; p23; p31; p32; p43; p51; p62 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" + +let getParenPatInnerPattern pat = + match pat with + | SynPat.Paren(pat, _) -> pat + | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Paren - Tuple 01`` () = + let parseResults = getParseResults """ +let (,) = () +let (,,) = () +let (,,,) = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map (getLetDeclHeadPattern >> getParenPatInnerPattern) + match pats with + | [ SynPat.Tuple(_, [SynPat.Wild _ as p11; SynPat.Wild _ as p12], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Wild _ as p22; SynPat.Wild _ as p23], _) + SynPat.Tuple(_, [SynPat.Wild _ as p31; SynPat.Wild _ as p32; SynPat.Wild _ as p33; SynPat.Wild _ as p34], _) ] -> + [ p11; p12; p21; p22; p23; p31; p32; p33; p34 ] |> checkNodeOrder + [ p11; p12; p21; p22; p23; p31; p32; p33; p34 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Paren - Tuple 02`` () = + let parseResults = getParseResults """ +let (1,) = () +let (,1) = () +let (1,1) = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map (getLetDeclHeadPattern >> getParenPatInnerPattern) + match pats with + | [ SynPat.Tuple(_, [SynPat.Const _ as p11; SynPat.Wild _ as p12], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Const _ as p22], _) + SynPat.Tuple(_, [SynPat.Const _ as p31; SynPat.Const _ as p32], _) ] -> + [ p11; p12; p21; p22; p31; p32 ] |> checkNodeOrder + [ p12; p21 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" + +[] +let ``Pattern - Paren - Tuple 03`` () = + let parseResults = getParseResults """ +let (1,,) = () +let (,1,) = () +let (,,1) = () + +let (1,1,) = () +let (,1,1) = () +let (1,,1) = () + +let (1,1,1) = () +""" + let pats = getSingleModuleMemberDecls parseResults |> List.map (getLetDeclHeadPattern >> getParenPatInnerPattern) + match pats with + | [ SynPat.Tuple(_, [SynPat.Const _ as p11; SynPat.Wild _ as p12; SynPat.Wild _ as p13], _) + SynPat.Tuple(_, [SynPat.Wild _ as p21; SynPat.Const _ as p22; SynPat.Wild _ as p23], _) + SynPat.Tuple(_, [SynPat.Wild _ as p31; SynPat.Wild _ as p32; SynPat.Const _ as p33], _) + + SynPat.Tuple(_, [SynPat.Const _ as p41; SynPat.Const _ as p42; SynPat.Wild _ as p43], _) + SynPat.Tuple(_, [SynPat.Wild _ as p51; SynPat.Const _ as p52; SynPat.Const _ as p53], _) + SynPat.Tuple(_, [SynPat.Const _ as p61; SynPat.Wild _ as p62; SynPat.Const _ as p63], _) + + SynPat.Tuple(_, [SynPat.Const _ as p71; SynPat.Const _ as p72; SynPat.Const _ as p73], _) ] -> + [ p11; p12; p13; p21; p22; p23; p31; p32; p33 + p41; p42; p43; p51; p52; p53; p61; p62; p63 + p71; p72; p73 ] |> checkNodeOrder + [ p12; p13; p21; p23; p31; p32; p43; p51; p62 ] |> List.iter assertIsEmptyRange + + | _ -> failwith "Unexpected tree" diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 4e56b7672e2..49117c04cea 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -46,7 +46,7 @@ match () with assertHasSymbolUsages ["x"; "y"; "CompiledNameAttribute"] checkResults dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,25): Attributes are not allowed within patterns" - "(3,4--3,16): This attribute is not valid for use on this language element" + "(3,4--3,23): This attribute is not valid for use on this language element" ] @@ -81,26 +81,6 @@ match 1, 2 with ] -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 01 - Missing field`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of int * int * int - -match A with -| B (x, _) -> let y = x + 1 in () -""" - assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,2--7,10): This union case expects 3 arguments in tupled form" - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - [] #if !NETCOREAPP [] @@ -197,47 +177,6 @@ match A with "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] - -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 07 - Named args - Name used twice`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of field: int * int - -match A with -| B (field = x; field = z) -> let y = x + z + 1 in () -""" - assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,16--7,21): Union case/exception field 'field' cannot be used more than once." - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 08 - Multiple tupled args`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of field: int * int - -match A with -| B x z -> let y = x + z + 1 in () -""" - assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,2--7,7): This union case expects 2 arguments in tupled form" - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - [] let ``Union case 09 - Single arg`` () = let _, checkResults = getParseAndCheckResults """ @@ -249,7 +188,6 @@ match None with dumpDiagnostics checkResults |> shouldEqual [ ] - [] #if !NETCOREAPP [] @@ -781,6 +719,7 @@ let z as = """ dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" + "(10,5--10,6): Expecting pattern" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" "(13,8--13,10): Unexpected keyword 'as' in binding" @@ -801,6 +740,7 @@ let z as = "(6,4--6,10): This runtime coercion or type test from type 'a to int involves an indeterminate type based on information prior to this program point. Runtime type tests are not allowed on some types. Further type annotations are needed." "(8,29--8,30): This expression was expected to have type 'unit' but here has type 'int'" "(9,26--9,27): This expression was expected to have type 'unit' but here has type 'int'" + "(10,14--10,15): This expression was expected to have type ''a * 'b' but here has type 'int'" "(15,4--15,5): The pattern discriminator 'r' is not defined." "(15,4--15,12): Incomplete pattern matches on this expression." ] @@ -1182,6 +1122,7 @@ let as :? z = """ dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" + "(10,5--10,6): Expecting pattern" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" "(13,8--13,10): Unexpected keyword 'as' in binding" @@ -1209,6 +1150,8 @@ let as :? z = "(8,25--8,29): The type 'unit' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." "(9,25--9,26): The type 'g' is not defined." "(9,22--9,26): The type 'unit' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." + "(10,13--10,14): The type 'i' is not defined." + "(10,10--10,14): The type ''a * 'b' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." "(16,4--16,5): The pattern discriminator 't' is not defined." "(16,14--16,15): The type 'u' is not defined." "(16,11--16,15): This runtime coercion or type test from type 'a to 'b involves an indeterminate type based on information prior to this program point. Runtime type tests are not allowed on some types. Further type annotations are needed." diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index b6af2161a86..c5d8c5f53ba 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -98,7 +98,7 @@ extern int private c() extern int AccessibleChildren()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(range = mb) ] , ml) ]) ])) -> assertRange (2, 0) (3, 31) ml @@ -113,7 +113,7 @@ extern void setCallbridgeSupportTarget(IntPtr newTarget) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = @@ -133,7 +133,7 @@ extern int AccessibleChildren(int* x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ @@ -157,7 +157,7 @@ extern int AccessibleChildren(obj& x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ @@ -181,7 +181,7 @@ extern int AccessibleChildren(void* x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ @@ -361,3 +361,15 @@ let tester2: int Group = [] |> should equal expectedTypeFormat | _ -> Assert.Fail (sprintf "Couldn't get member: %s" entityName) ) + + [] + let ``FsharpType.Format default to arrayNd shorthands for multidimensional arrays`` ([]rank) = + let commas = System.String(',', rank - 1) + let _, checkResults = getParseAndCheckResults $""" let myArr : int[{commas}] = Unchecked.defaultOf<_>""" + let symbolUse = findSymbolUseByName "myArr" checkResults + match symbolUse.Symbol with + | :? FSharpMemberOrFunctionOrValue as v -> + v.FullType.Format symbolUse.DisplayContext + |> shouldEqual $"int array{rank}d" + + | other -> Assert.Fail(sprintf "myArr was supposed to be a value, but is %A" other) diff --git a/tests/service/SyntaxTreeTests/AttributeTests.fs b/tests/service/SyntaxTreeTests/AttributeTests.fs new file mode 100644 index 00000000000..c31aefae85f --- /dev/null +++ b/tests/service/SyntaxTreeTests/AttributeTests.fs @@ -0,0 +1,50 @@ +module FSharp.Compiler.Service.Tests.SyntaxTreeTests.AttributeTests + +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Syntax +open NUnit.Framework + +[] +let ``range of attribute`` () = + let ast = + """ +[] +do () +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = + [ SynModuleDecl.Attributes(attributes = [ { Attributes = [ { Range = mAttribute } ] } ]) ; SynModuleDecl.Expr _ ] ) ])) -> + assertRange (2, 2) (2, 25) mAttribute + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + +[] +let ``range of attribute with path`` () = + let ast = + """ +[] +do () +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = + [ SynModuleDecl.Attributes(attributes = [ { Attributes = [ { Range = mAttribute } ] } ]) ; SynModuleDecl.Expr _ ] ) ])) -> + assertRange (2, 2) (2, 32) mAttribute + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + +[] +let ``range of attribute with target`` () = + let ast = + """ +[] +do () +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = + [ SynModuleDecl.Attributes(attributes = [ { Attributes = [ { Range = mAttribute } ] } ]) ; SynModuleDecl.Expr _ ] ) ])) -> + assertRange (2, 2) (2, 35) mAttribute + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" diff --git a/tests/service/SyntaxTreeTests/BindingTests.fs b/tests/service/SyntaxTreeTests/BindingTests.fs index c132b306ecd..95ea6685947 100644 --- a/tests/service/SyntaxTreeTests/BindingTests.fs +++ b/tests/service/SyntaxTreeTests/BindingTests.fs @@ -13,7 +13,7 @@ let ``Range of attribute should be included in SynModuleDecl.Let`` () = let a = 0""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(range = mb)]) as lt ]) ])) -> assertRange (2, 0) (3, 5) mb @@ -28,7 +28,7 @@ let ``Range of attribute between let keyword and pattern should be included in S let [] (A x) = 1""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(range = mb)]) as lt ]) ])) -> assertRange (2, 4) (2, 21) mb @@ -45,7 +45,7 @@ type Bar = let x = 8""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.LetBindings(bindings = [SynBinding(range = mb)]) as m]))]) ]) ])) -> assertRange (3, 4) (4, 9) mb @@ -62,7 +62,7 @@ type Bar = member this.Something () = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 28) mb @@ -79,7 +79,7 @@ let ``Range of attribute should be included in binding of SynExpr.ObjExpr`` () = member x.ToString() = "F#" }""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(members = [SynMemberDefn.Member(memberDefn=SynBinding(range = mb))])) ]) ])) -> assertRange (3, 4) (4, 23) mb @@ -95,7 +95,7 @@ type Tiger = new () = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 10) mb @@ -112,7 +112,7 @@ type Tiger = new () as tony = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 18) mb @@ -136,7 +136,7 @@ type T() = T ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.ImplicitCtor _ SynMemberDefn.Member(memberDefn = SynBinding(range = mb1)) as m1 @@ -162,7 +162,7 @@ type Crane = member this.MyWriteOnlyProperty with set (value) = myInternalValue <- value""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.GetSetMember(memberDefnForSet = Some (SynBinding(range = mb))) as m]))]) ]) ])) -> @@ -182,7 +182,7 @@ type Bird = and set (value) = myInternalValue <- value""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.GetSetMember(Some (SynBinding(range = mb1)), Some (SynBinding(range = mb2)), m, _) ]))]) @@ -198,7 +198,7 @@ let ``Range of equal sign should be present in SynModuleDecl.Let binding`` () = getParseResults "let v = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]) ]) ])) -> assertRange (1, 6) (1, 7) mEquals @@ -210,7 +210,7 @@ let ``Range of equal sign should be present in SynModuleDecl.Let binding, typed` getParseResults "let v : int = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]) ]) ])) -> assertRange (1, 12) (1, 13) mEquals @@ -227,7 +227,7 @@ do """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]))) ]) ])) -> assertRange (3, 10) (3, 11) mEquals @@ -244,7 +244,7 @@ do """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]))) ]) ])) -> assertRange (3, 15) (3, 16) mEquals @@ -260,7 +260,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 18) (3, 19) mEquals @@ -276,7 +276,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 21) (3, 22) mEquals @@ -292,7 +292,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 30) (3, 31) mEquals @@ -310,7 +310,7 @@ type Y() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _ SynMemberDefn.GetSetMember( @@ -328,7 +328,7 @@ let ``Range of let keyword should be present in SynModuleDecl.Let binding`` () = getParseResults "let v = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ LetKeyword = Some mLet })]) ]) ])) -> assertRange (1, 0) (1, 3) mLet @@ -345,7 +345,7 @@ let v = 12 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ LetKeyword = Some mLet })]) ]) ])) -> assertRange (5, 0) (5, 3) mLet @@ -361,7 +361,7 @@ let a = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(expr=SynExpr.LetOrUse(bindings=[SynBinding(trivia={ LetKeyword = Some mLet })]))]) ]) ])) -> assertRange (3, 4) (3, 7) mLet @@ -376,7 +376,7 @@ let b : int * string * bool = 1, "", false """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(path = [ diff --git a/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs b/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs index 5a1de7621bd..243a06165c8 100644 --- a/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs +++ b/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs @@ -18,7 +18,7 @@ async { """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = SynExpr.LetOrUseBang(andBangs = [ SynExprAndBang(range = mAndBang) @@ -42,7 +42,7 @@ async { """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = SynExpr.LetOrUseBang(andBangs = [ SynExprAndBang(range = mAndBang1; trivia={ InKeyword = Some mIn }) diff --git a/tests/service/SyntaxTreeTests/EnumCaseTests.fs b/tests/service/SyntaxTreeTests/EnumCaseTests.fs index 60dd4a1e6eb..1363ab095ac 100644 --- a/tests/service/SyntaxTreeTests/EnumCaseTests.fs +++ b/tests/service/SyntaxTreeTests/EnumCaseTests.fs @@ -12,7 +12,7 @@ type Foo = | Bar = 1 |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -36,7 +36,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -61,7 +61,7 @@ type Foo = Bar = 1 |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ diff --git a/tests/service/SyntaxTreeTests/ExceptionTests.fs b/tests/service/SyntaxTreeTests/ExceptionTests.fs index cd0ccef1cd1..a712eba5e6f 100644 --- a/tests/service/SyntaxTreeTests/ExceptionTests.fs +++ b/tests/service/SyntaxTreeTests/ExceptionTests.fs @@ -16,7 +16,7 @@ exception Foo with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace(decls = [ SynModuleDecl.Exception( exnDefn=SynExceptionDefn(withKeyword = Some mWithKeyword) ) diff --git a/tests/service/SyntaxTreeTests/ExpressionTests.fs b/tests/service/SyntaxTreeTests/ExpressionTests.fs index eb18d053d6a..a7f1dcbb8df 100644 --- a/tests/service/SyntaxTreeTests/ExpressionTests.fs +++ b/tests/service/SyntaxTreeTests/ExpressionTests.fs @@ -16,7 +16,7 @@ let ``SynExpr.Do contains the range of the do keyword`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = SynExpr.Sequential(expr1 = SynExpr.Do(_, doRange) ; expr2 = SynExpr.DoBang(_, doBangRange))) @@ -41,7 +41,7 @@ comp { |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = @@ -67,7 +67,7 @@ let ``SynExpr.Record contains the range of the equals sign in SynExprRecordField |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(recordFields = [ @@ -89,7 +89,7 @@ let ``inherit SynExpr.Record contains the range of the equals sign in SynExprRec |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(baseInfo = Some _ ; recordFields = [ @@ -112,7 +112,7 @@ let ``copy SynExpr.Record contains the range of the equals sign in SynExprRecord |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(copyInfo = Some _ ; recordFields = [ @@ -134,7 +134,7 @@ let ``SynExpr.AnonRecord contains the range of the equals sign in the fields`` ( |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.AnonRecd(recordFields = [ @@ -159,7 +159,7 @@ printf "%d " i |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.For(equalsRange = Some mEquals)) @@ -180,7 +180,7 @@ with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(trivia={ TryKeyword = mTry; WithKeyword = mWith })) @@ -202,7 +202,7 @@ finally |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryFinally(trivia={ TryKeyword = mTry; FinallyKeyword = mFinally })) @@ -222,7 +222,7 @@ match x with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(trivia = { MatchKeyword = mMatch; WithKeyword = mWith })) @@ -242,7 +242,7 @@ match! x with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.MatchBang(trivia = { MatchBangKeyword = mMatch; WithKeyword = mWith })) @@ -265,7 +265,7 @@ let ``SynExpr.ObjExpr contains the range of with keyword`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(withKeyword=Some mWithObjExpr; extraImpls=[ SynInterfaceImpl(withKeyword=None); SynInterfaceImpl(withKeyword=Some mWithSynInterfaceImpl) ])) @@ -281,7 +281,7 @@ let ``SynExpr.LetOrUse contains the range of in keyword`` () = getParseResults "let x = 1 in ()" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LetOrUse(trivia={ InKeyword = Some mIn })) @@ -301,7 +301,7 @@ do """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings=[_;_]; trivia={ InKeyword = Some mIn }))) @@ -321,7 +321,7 @@ let f () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = @@ -343,7 +343,7 @@ let x = 1 """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(trivia={ InKeyword = None }))) @@ -362,7 +362,7 @@ e1.Key, e1.Value """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(trivia={ InKeyword = None }))) @@ -379,7 +379,7 @@ global """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LongIdent(longDotId = SynLongIdent([mangledGlobal], [], [Some (IdentTrivia.OriginalNotation "global")])) @@ -400,7 +400,7 @@ let ``SynExprRecordFields contain correct amount of trivia`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(recordFields = [ @@ -420,7 +420,7 @@ let ``SynExpr.Dynamic does contain ident`` () = getParseResults "x?k" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Dynamic (_, _, SynExpr.Ident(idK) ,mDynamicExpr)) ]) @@ -435,7 +435,7 @@ let ``SynExpr.Dynamic does contain parentheses`` () = getParseResults "x?(g)" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Dynamic (_, _, SynExpr.Paren(SynExpr.Ident(idG), lpr, Some rpr, mParen) ,mDynamicExpr)) @@ -454,7 +454,7 @@ let ``SynExpr.Set with SynExpr.Dynamic`` () = getParseResults "x?v <- 2" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Set( SynExpr.Dynamic (_, _, SynExpr.Ident(idV) ,mDynamicExpr), @@ -481,7 +481,7 @@ type CFoo() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types _ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(members = [ diff --git a/tests/service/SyntaxTreeTests/ExternTests.fs b/tests/service/SyntaxTreeTests/ExternTests.fs new file mode 100644 index 00000000000..0599307d994 --- /dev/null +++ b/tests/service/SyntaxTreeTests/ExternTests.fs @@ -0,0 +1,21 @@ +module FSharp.Compiler.Service.Tests.SyntaxTreeTests.ExternTests + +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTrivia +open NUnit.Framework + +[] +let ``extern keyword is present in trivia`` () = + let parseResults = getParseResults "extern void GetProcessHeap()" + + match parseResults with + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Let(bindings = [ + SynBinding(trivia = { ExternKeyword = Some mExtern }) + ]) + ]) + ])) -> + assertRange (1, 0) (1, 6) mExtern + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" diff --git a/tests/service/SyntaxTreeTests/IfThenElseTests.fs b/tests/service/SyntaxTreeTests/IfThenElseTests.fs index 7db54e4dfef..66cf9a82849 100644 --- a/tests/service/SyntaxTreeTests/IfThenElseTests.fs +++ b/tests/service/SyntaxTreeTests/IfThenElseTests.fs @@ -11,7 +11,7 @@ let ``If keyword in IfThenElse`` () = "if a then b" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = None }) ) @@ -27,7 +27,7 @@ let ``Else keyword in simple IfThenElse`` () = "if a then b else c" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr =SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse }) ) @@ -47,7 +47,7 @@ then b else c""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse }) ) @@ -67,7 +67,7 @@ b elif c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif=false; ThenKeyword = mThenKw; ElseKeyword = None } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElif; IsElif = true }))) @@ -89,7 +89,7 @@ else if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElseIf; IsElif = false }))) @@ -112,7 +112,7 @@ else if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif=false; ThenKeyword = mThenKw; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElseIf; IsElif = false }))) @@ -140,7 +140,7 @@ else g""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIf1; IsElif = false; ElseKeyword = None } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElif; IsElif = true; ElseKeyword = Some mElse1 } @@ -165,7 +165,7 @@ else (* some long comment here *) if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIf1; IsElif = false; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia = { IfKeyword = mIf2; IsElif = false })))) diff --git a/tests/service/SyntaxTreeTests/LambdaTests.fs b/tests/service/SyntaxTreeTests/LambdaTests.fs index 788279f8e76..ebc343507ab 100644 --- a/tests/service/SyntaxTreeTests/LambdaTests.fs +++ b/tests/service/SyntaxTreeTests/LambdaTests.fs @@ -11,7 +11,7 @@ let ``Lambda with two parameters gives correct body`` () = "fun a b -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Named _], SynExpr.Ident ident)) ) @@ -26,7 +26,7 @@ let ``Lambda with wild card parameter gives correct body`` () = "fun a _ b -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Wild _; SynPat.Named _], SynExpr.Ident ident)) ) @@ -41,7 +41,7 @@ let ``Lambda with tuple parameter with wild card gives correct body`` () = "fun a (b, _) c -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Paren(SynPat.Tuple _,_); SynPat.Named _], SynExpr.Ident ident)) ) @@ -56,7 +56,7 @@ let ``Lambda with wild card that returns a lambda gives correct body`` () = "fun _ -> fun _ -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Ident ident)))) ) @@ -71,7 +71,7 @@ let ``Simple lambda has arrow range`` () = "fun x -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -88,7 +88,7 @@ let ``Multiline lambda has arrow range`` () = x * y * z" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -103,7 +103,7 @@ let ``Destructed lambda has arrow range`` () = "fun { X = x } -> x * 2" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -118,7 +118,7 @@ let ``Tuple in lambda has arrow range`` () = "fun (x, _) -> x * 3" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -137,7 +137,7 @@ let ``Complex arguments lambda has arrow range`` () = x * y + z" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) diff --git a/tests/service/SyntaxTreeTests/MatchClauseTests.fs b/tests/service/SyntaxTreeTests/MatchClauseTests.fs index caa6c5d6da5..5c68abb598a 100644 --- a/tests/service/SyntaxTreeTests/MatchClauseTests.fs +++ b/tests/service/SyntaxTreeTests/MatchClauseTests.fs @@ -17,7 +17,7 @@ with ex -> None""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (5, 5) (7, 8) range @@ -40,7 +40,7 @@ with None""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = r1) as clause1 SynMatchClause(range = r2) as clause2 ])) ]) ])) -> @@ -65,7 +65,7 @@ with | """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (7, 6) range @@ -84,7 +84,7 @@ with | ex ->""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (6, 4) range @@ -103,7 +103,7 @@ with | ex when (isNull ex) ->""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (6, 21) range @@ -119,7 +119,7 @@ match foo with | Bar bar -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ ArrowRange = Some mArrow }) ])) ]) ])) -> assertRange (3, 10) (3, 12) mArrow @@ -134,7 +134,7 @@ match foo with | Bar bar when (someCheck bar) -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ ArrowRange = Some mArrow }) ])) ]) ])) -> assertRange (3, 31) (3, 33) mArrow @@ -149,7 +149,7 @@ match foo with | Bar bar when (someCheck bar) -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ BarRange = Some mBar }) ])) ]) ])) -> assertRange (3, 0) (3, 1) mBar @@ -165,7 +165,7 @@ match foo with | Far too -> near ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ BarRange = Some mBar1 }) SynMatchClause(trivia={ BarRange = Some mBar2 }) ])) ]) ])) -> @@ -184,7 +184,7 @@ with | exn -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = Some mBar }) ])) ]) ])) -> assertRange (5, 0) (5, 1) mBar @@ -202,7 +202,7 @@ with exn -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = None }) ])) ]) ])) -> Assert.Pass() @@ -222,7 +222,7 @@ with | ex -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = Some mBar1 }) SynMatchClause(trivia={ BarRange = Some mBar2 }) ])) ]) ])) -> diff --git a/tests/service/SyntaxTreeTests/MeasureTests.fs b/tests/service/SyntaxTreeTests/MeasureTests.fs index 0e618693df9..f8c9f29271a 100644 --- a/tests/service/SyntaxTreeTests/MeasureTests.fs +++ b/tests/service/SyntaxTreeTests/MeasureTests.fs @@ -14,7 +14,7 @@ let m = 7.000 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding.SynBinding(expr = SynExpr.Const(SynConst.Measure(constantRange = r1), _)) ]) SynModuleDecl.Let(bindings = [ SynBinding.SynBinding(expr = SynExpr.Const(SynConst.Measure(constantRange = r2), _)) ]) ]) ])) -> @@ -31,7 +31,7 @@ let ``SynMeasure.Paren has correct range`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Const(SynConst.Measure(SynConst.UInt32 _, _, SynMeasure.Divide( SynMeasure.Seq([ SynMeasure.Named([ hrIdent ], _) ], _), @@ -62,7 +62,7 @@ let ``SynType.Tuple in measure type with no slashes`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = @@ -85,7 +85,7 @@ let ``SynType.Tuple in measure type with leading slash`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = @@ -107,7 +107,7 @@ let ``SynType.Tuple in measure type with start and slash`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = diff --git a/tests/service/SyntaxTreeTests/MemberFlagTests.fs b/tests/service/SyntaxTreeTests/MemberFlagTests.fs index b95d91bae9d..c29aad29300 100644 --- a/tests/service/SyntaxTreeTests/MemberFlagTests.fs +++ b/tests/service/SyntaxTreeTests/MemberFlagTests.fs @@ -22,7 +22,7 @@ type Y = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(types =[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[ SynMemberSig.Member(flags={ Trivia= { AbstractRange = Some mAbstract1 } }) @@ -56,7 +56,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -85,7 +85,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -124,7 +124,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -158,7 +158,7 @@ let meh = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let (bindings = [ SynBinding(expr=SynExpr.ObjExpr( diff --git a/tests/service/SyntaxTreeTests/MemberTests.fs b/tests/service/SyntaxTreeTests/MemberTests.fs new file mode 100644 index 00000000000..084af4bff85 --- /dev/null +++ b/tests/service/SyntaxTreeTests/MemberTests.fs @@ -0,0 +1,225 @@ +module FSharp.Compiler.Service.Tests.SyntaxTreeTests.MemberTests + +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTrivia +open NUnit.Framework + +[] +let ``SynTypeDefn with AutoProperty contains the range of the equals sign`` () = + let parseResults = + getParseResults + """ +/// mutable class with auto-properties +type Person(name : string, age : int) = + /// Full name + member val Name = name with get, set +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ ; SynMemberDefn.AutoProperty(equalsRange = mEquals)])) ] + ) + ]) ])) -> + assertRange (5, 20) (5, 21) mEquals + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``SynTypeDefn with AutoProperty contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + member val AutoProperty = autoProp with get, set + member val AutoProperty2 = autoProp +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ + SynMemberDefn.AutoProperty(withKeyword=Some mWith) + SynMemberDefn.AutoProperty(withKeyword=None)])) ] + ) + ]) ])) -> + assertRange (3, 39) (3, 43) mWith + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``SynTypeDefn with AbstractSlot contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + abstract member Bar : int with get,set +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ + SynMemberDefn.AbstractSlot(slotSig=SynValSig(trivia = { WithKeyword = Some mWith }))])) ] + ) + ]) ])) -> + assertRange (3, 30) (3, 34) mWith + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``read-only property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A read-only property. + member this.MyReadProperty with get () = myInternalValue +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ + _ + SynMemberDefn.GetSetMember(Some(SynBinding _), None, _, { WithKeyword = mWith }) ]) + ) ]) + ]) ])) -> + assertRange (4, 31) (4, 35) mWith + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``write-only property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A write-only property. + member this.MyWriteOnlyProperty with set (value) = myInternalValue <- value +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ + _ + SynMemberDefn.GetSetMember(None, Some(SynBinding _), _, { WithKeyword = mWith }) ]) + ) ]) + ]) ])) -> + assertRange (4, 36) (4, 40) mWith + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``read/write property in SynMemberDefn.Member contains the range of the with keyword`` () = + let parseResults = + getParseResults + """ +type Foo() = + // A read-write property. + member this.MyReadWriteProperty + with get () = myInternalValue + and set (value) = myInternalValue <- value +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = + SynTypeDefnRepr.ObjectModel(members=[ + _ + SynMemberDefn.GetSetMember(Some _, Some _, _, { WithKeyword = mWith; AndKeyword = Some mAnd }) ]) + ) ]) + ]) ])) -> + assertRange (5, 8) (5, 12) mWith + assertRange (6, 8) (6, 11) mAnd + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``SynTypeDefn with static member with get/set`` () = + let parseResults = + getParseResults + """ +type Foo = + static member ReadWrite2 + with set x = lastUsed <- ("ReadWrite2", x) + and get () = lastUsed <- ("ReadWrite2", 0); 4 +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ + SynMemberDefn.GetSetMember(Some _, Some _, m, { WithKeyword = mWith + GetKeyword = Some mGet + AndKeyword = Some mAnd + SetKeyword = Some mSet }) + ])) ] + ) + ]) ])) -> + assertRange (4, 8) (4, 12) mWith + assertRange (4, 13) (4, 16) mSet + assertRange (5, 8) (5, 11) mAnd + assertRange (5, 13) (5, 16) mGet + assertRange (3, 4) (5, 54) m + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``SynTypeDefn with member with set/get`` () = + let parseResults = + getParseResults + """ +type A() = + member this.Z with set (_:int):unit = () and get():int = 1 +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ + SynMemberDefn.ImplicitCtor _ + SynMemberDefn.GetSetMember(Some (SynBinding(headPat = SynPat.LongIdent(extraId = Some getIdent))), + Some (SynBinding(headPat = SynPat.LongIdent(extraId = Some setIdent))), + m, + { WithKeyword = mWith + GetKeyword = Some mGet + AndKeyword = Some mAnd + SetKeyword = Some mSet }) + ])) ] + ) + ]) ])) -> + Assert.AreEqual("get", getIdent.idText) + Assert.AreEqual("set", setIdent.idText) + assertRange (3, 18) (3, 22) mWith + assertRange (3, 23) (3, 26) mSet + assertRange (3, 23) (3, 26) setIdent.idRange + assertRange (3, 45) (3, 48) mAnd + assertRange (3, 49) (3, 52) mGet + assertRange (3, 49) (3, 52) getIdent.idRange + assertRange (3, 4) (3, 62) m + | _ -> Assert.Fail "Could not get valid AST" + +[] +let ``SynTypeDefn with member with get has xml comment`` () = + let parseResults = + getParseResults + """ +type A = + /// B + member x.B with get() = 5 +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Types( + typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ + SynMemberDefn.GetSetMember(Some (SynBinding(xmlDoc = preXmlDoc)), + None, + _, + _) + ])) ] + ) + ]) ])) -> + Assert.False preXmlDoc.IsEmpty + let comment = preXmlDoc.ToXmlDoc(false, None).GetXmlText() + Assert.False (System.String.IsNullOrWhiteSpace(comment)) + | _ -> Assert.Fail "Could not get valid AST" diff --git a/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs b/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs index bf9c025c36a..ec215cb41be 100644 --- a/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs +++ b/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs @@ -15,7 +15,7 @@ type Bar = | Bar of string * int """ match parseResults with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.DeclaredNamespace) as singleModule ])) -> assertRange (2,0) (4,32) singleModule.Range @@ -33,7 +33,7 @@ type Bar = | Bar of string * int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.GlobalNamespace; range = r) ])) -> assertRange (3, 0) (5, 32) r | _ -> Assert.Fail "Could not get valid AST" @@ -50,7 +50,7 @@ val s : string """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.NamedModule; range = r) ])) -> assertRange (2, 1) (5, 14) r | _ -> Assert.Fail "Could not get valid AST" @@ -66,7 +66,7 @@ val a: int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.NamedModule; trivia = { ModuleKeyword = Some mModule; NamespaceKeyword = None }) ])) -> assertRange (2, 0) (2, 6) mModule | _ -> Assert.Fail "Could not get valid AST" @@ -82,7 +82,7 @@ val a: int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.DeclaredNamespace; trivia = { ModuleKeyword = None; NamespaceKeyword = Some mNamespace }) ])) -> assertRange (2, 0) (2, 9) mNamespace | _ -> Assert.Fail "Could not get valid AST" \ No newline at end of file diff --git a/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs b/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs index 8091c0942d6..fcba2811028 100644 --- a/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs +++ b/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs @@ -16,7 +16,7 @@ type Teq<'a, 'b> """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ])) -> + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ])) -> assertRange (1, 0) (4, 8) r | _ -> Assert.Fail "Could not get valid AST" @@ -35,7 +35,7 @@ let x = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r1) SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r2) ])) -> assertRange (1, 0) (4, 20) r1 @@ -54,7 +54,7 @@ type X = int """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.GlobalNamespace; range = r) ])) -> assertRange (3, 0) (5, 12) r | _ -> Assert.Fail "Could not get valid AST" @@ -71,7 +71,7 @@ let s : string = "s" """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.NamedModule; range = r) ])) -> assertRange (2, 0) (5, 20) r | _ -> Assert.Fail "Could not get valid AST" @@ -96,7 +96,7 @@ let a = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.NamedModule; trivia = { ModuleKeyword = Some mModule; NamespaceKeyword = None }) ])) -> assertRange (5, 0) (5, 6) mModule | _ -> Assert.Fail "Could not get valid AST" @@ -112,7 +112,7 @@ let a = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; trivia = { ModuleKeyword = None; NamespaceKeyword = Some mNamespace }) ])) -> assertRange (2, 0) (2, 9) mNamespace | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" @@ -128,7 +128,7 @@ open global.Node """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Open(target = SynOpenDeclTarget.ModuleOrNamespace(longId = SynLongIdent(trivia = [ Some (IdentTrivia.OriginalNotation("global")); None ]))) ]) ])) -> diff --git a/tests/service/SyntaxTreeTests/NestedModuleTests.fs b/tests/service/SyntaxTreeTests/NestedModuleTests.fs index d6dcac70f76..fcdde98008a 100644 --- a/tests/service/SyntaxTreeTests/NestedModuleTests.fs +++ b/tests/service/SyntaxTreeTests/NestedModuleTests.fs @@ -18,7 +18,7 @@ module Nested = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule _ as nm ]) as sigModule ])) -> assertRange (4, 0) (6, 15) nm.Range @@ -37,7 +37,7 @@ module Nested = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule _ as nm ]) ])) -> assertRange (4, 0) (6, 6) nm.Range @@ -53,7 +53,7 @@ module X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule(trivia = { ModuleKeyword = Some mModule; EqualsRange = Some mEquals }) ]) ])) -> assertRange (2, 0) (2, 6) mModule @@ -72,7 +72,7 @@ val bar : int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule(trivia = { ModuleKeyword = Some mModule; EqualsRange = Some mEquals }) ]) ])) -> assertRange (4, 0) (4, 6) mModule @@ -146,7 +146,7 @@ module Operators = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Open _ SynModuleSigDecl.Open _ SynModuleSigDecl.Open _ diff --git a/tests/service/SyntaxTreeTests/OperatorNameTests.fs b/tests/service/SyntaxTreeTests/OperatorNameTests.fs index ce64e19b85e..9efbb4dc972 100644 --- a/tests/service/SyntaxTreeTests/OperatorNameTests.fs +++ b/tests/service/SyntaxTreeTests/OperatorNameTests.fs @@ -13,7 +13,7 @@ let ``operator as function`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.App(funcExpr = SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.OriginalNotationWithParen(lpr, "+", rpr))]))))) @@ -33,7 +33,7 @@ let ``active pattern as function `` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.LongIdent(false, SynLongIdent([ ident ], _, [ Some(IdentTrivia.HasParenthesis(lpr, rpr)) ]), None, pr))) @@ -54,7 +54,7 @@ let ``partial active pattern as function `` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.LongIdent(false, SynLongIdent([ ident ], _, [ Some(IdentTrivia.HasParenthesis(lpr, rpr)) ]), None, pr))) @@ -75,7 +75,7 @@ let (+) a b = a + b |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ ident ],_, [ Some (IdentTrivia.OriginalNotationWithParen(lpr, "+", rpr)) ]))) @@ -95,7 +95,7 @@ let (|Odd|Even|) (a: int) = if a % 2 = 0 then Even else Odd |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.HasParenthesis(lpr, rpr))]))) @@ -115,7 +115,7 @@ let (|Int32Const|_|) (a: SynConst) = match a with SynConst.Int32 _ -> Some a | _ |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.HasParenthesis(lpr, rpr))]))) @@ -135,7 +135,7 @@ let (|Boolean|_|) = Boolean.parse |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.Named(ident = SynIdent(ident, Some (IdentTrivia.HasParenthesis(lpr, rpr))))) @@ -157,7 +157,7 @@ val (&): e1: bool -> e2: bool -> bool |> getParseResultsOfSignatureFile match ast with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(ident = SynIdent(ident, Some (IdentTrivia.OriginalNotationWithParen(lpr, "&", rpr))) ))]) @@ -186,7 +186,7 @@ let ``operator name in val constraint`` () = """ match ast with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(synType=SynType.WithGlobalConstraints(constraints=[ SynTypeConstraint.WhereTyparSupportsMember(memberSig=SynMemberSig.Member(memberSig=SynValSig(ident = @@ -208,7 +208,7 @@ f(x=4) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(argExpr = SynExpr.Paren(expr = SynExpr.App(funcExpr= SynExpr.App(funcExpr= SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.OriginalNotation "=")]))))))) @@ -226,7 +226,7 @@ let ``infix operation`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(funcExpr = SynExpr.App(isInfix = true @@ -247,7 +247,7 @@ let ``prefix operation`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -267,7 +267,7 @@ let ``prefix operation with two characters`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -289,7 +289,7 @@ op_Addition a b """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(funcExpr = SynExpr.App(isInfix = false @@ -324,7 +324,7 @@ type X with """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(members = [ @@ -350,7 +350,7 @@ nameof(+) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -375,7 +375,7 @@ f(?x = 7) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -408,7 +408,7 @@ type X() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members =[ @@ -437,7 +437,7 @@ let PowByte (x:byte) n = Checked.( * ) x """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = SynExpr.App(funcExpr = @@ -465,7 +465,7 @@ type A() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ diff --git a/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs b/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs index d59587c6b36..f834680fdff 100644 --- a/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs +++ b/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs @@ -11,7 +11,7 @@ let ``SourceIdentifier as ParsedHashDirectiveArgument`` () = "#I __SOURCE_DIRECTORY__" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.SourceIdentifier(c,_,m) ] , _), _) ]) ])) -> Assert.AreEqual("__SOURCE_DIRECTORY__", c) @@ -25,7 +25,7 @@ let ``Regular String as ParsedHashDirectiveArgument`` () = "#I \"/tmp\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.String(v, SynStringKind.Regular, m) ] , _), _) ]) ])) -> Assert.AreEqual("/tmp", v) @@ -39,7 +39,7 @@ let ``Verbatim String as ParsedHashDirectiveArgument`` () = "#I @\"C:\\Temp\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.String(v, SynStringKind.Verbatim, m) ] , _), _) ]) ])) -> Assert.AreEqual("C:\\Temp", v) @@ -53,7 +53,7 @@ let ``Triple quote String as ParsedHashDirectiveArgument`` () = "#nowarn \"\"\"40\"\"\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("nowarn", [ ParsedHashDirectiveArgument.String(v, SynStringKind.TripleQuote, m) ] , _), _) ]) ])) -> Assert.AreEqual("40", v) diff --git a/tests/service/SyntaxTreeTests/PatternTests.fs b/tests/service/SyntaxTreeTests/PatternTests.fs index 42905ec976f..c03325e6077 100644 --- a/tests/service/SyntaxTreeTests/PatternTests.fs +++ b/tests/service/SyntaxTreeTests/PatternTests.fs @@ -16,7 +16,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.Record(fieldPats = [ (_, mEquals, _) ])) ; _ ]) ) @@ -34,7 +34,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.LongIdent(argPats = SynArgPats.NamePatPairs(pats = [ _, mEquals ,_ ])))]) ) @@ -54,7 +54,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.Or(trivia={ BarRange = mBar })) ; _ ]) ) @@ -71,12 +71,12 @@ let (head::tail) = [ 1;2;4] """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let( - bindings = [ SynBinding(headPat = SynPat.Paren(SynPat.LongIdent(longDotId = SynLongIdent([ opColonColonIdent ], _, [ Some (IdentTrivia.OriginalNotation "::") ])), _)) ] + bindings = [ SynBinding(headPat = SynPat.Paren(pat = SynPat.ListCons(trivia = trivia))) ] ) ]) ])) -> - Assert.AreEqual("op_ColonColon", opColonColonIdent.idText) + assertRange (2,9) (2,11) trivia.ColonColonRange | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" [] @@ -89,12 +89,52 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ - SynMatchClause(pat = SynPat.LongIdent(longDotId = SynLongIdent([ opColonColonIdent ], _, [ Some (IdentTrivia.OriginalNotation "::") ]))) + SynMatchClause(pat = SynPat.ListCons(trivia = trivia)) ]) ) ]) ])) -> - Assert.AreEqual("op_ColonColon", opColonColonIdent.idText) - | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" \ No newline at end of file + assertRange (3, 9) (3, 11) trivia.ColonColonRange + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" + +[] +let ``Parentheses of SynArgPats.NamePatPairs`` () = + let parseResults = + getParseResults + """ +match data with +| OnePartData( // foo + part1 = p1 + (* bar *) ) -> p1 +| _ -> failwith "todo" +""" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Expr( + expr = SynExpr.Match(clauses = [ + SynMatchClause(pat = SynPat.LongIdent(argPats = SynArgPats.NamePatPairs(trivia = trivia))) + _ + ]) + ) + ]) ])) -> + assertRange (3, 13) (5, 13) trivia.ParenRange + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" + +[] +let ``:: in head pattern`` () = + let parseResults = + getParseResults + """ +let 1 :: _ = [ 4; 5; 6 ] +""" + + match parseResults with + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace(decls = [ + SynModuleDecl.Let(bindings = [ SynBinding(headPat = + SynPat.ListCons(trivia = trivia)) ]) + ]) ])) -> + assertRange (2,6) (2, 8) trivia.ColonColonRange + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" diff --git a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs index e7f8055fee9..7532e835ca2 100644 --- a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs +++ b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs @@ -18,7 +18,7 @@ type Meh = // foo""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(range = r)]) ])) -> assertRange (3, 0) (5,11) r | _ -> Assert.Fail "Could not get valid AST" @@ -33,7 +33,7 @@ type MyRecord = member Score : unit -> int""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 30) mTypes assertRange (2, 5) (4, 30) mSynTypeDefnSig @@ -50,7 +50,7 @@ type MyRecord = member Score : unit -> int""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (5, 30) mTypes assertRange (2, 5) (5, 30) mSynTypeDefnSig @@ -65,7 +65,7 @@ type MyFunction = delegate of int -> string""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> assertRange (2, 0) (3, 29) mTypes assertRange (2, 5) (3, 29) mSynTypeDefnSig @@ -81,7 +81,7 @@ type SomeCollection with val SomeThingElse : int -> string""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 37) mTypes assertRange (2, 5) (4, 37) mSynTypeDefnSig @@ -101,7 +101,7 @@ type MyType = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> assertRange (4, 0) (7, 7) r assertRange (4, 0) (7, 7) t.Range @@ -126,7 +126,7 @@ and [] Bang = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([ SynTypeDefnSig.SynTypeDefnSig(range = r1) SynTypeDefnSig.SynTypeDefnSig(range = r2) @@ -149,7 +149,7 @@ type FooType = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(types = [ SynTypeDefnSig.SynTypeDefnSig(typeRepr = @@ -171,7 +171,7 @@ type X = delegate of string -> string """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _)) ] @@ -193,7 +193,7 @@ type Foobar = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Class)) ] @@ -215,7 +215,7 @@ type Bear = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = @@ -243,7 +243,7 @@ type Shape = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Union _)) ] @@ -264,7 +264,7 @@ member Meh : unit -> unit """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules =[ SynModuleOrNamespaceSig(decls =[ + | ParsedInput.SigFile (ParsedSigFileInput (contents =[ SynModuleOrNamespaceSig(decls =[ SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.Simple _ trivia = { WithKeyword = Some mWithKeyword }) ] @@ -285,7 +285,7 @@ member Meh : unit -> unit """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Exception( exnSig=SynExceptionSig(withKeyword = Some mWithKeyword) ) @@ -305,7 +305,7 @@ type Foo = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[SynMemberSig.Member(memberSig=SynValSig(trivia = { WithKeyword = Some mWithKeyword }))])) ] ) @@ -328,7 +328,7 @@ exception SyntaxError of obj * range: range """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) @@ -352,7 +352,7 @@ open Foo """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) @@ -376,7 +376,7 @@ val a : int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) ] ) ])) -> @@ -394,7 +394,7 @@ val a : int = 9 """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) ] ) ])) -> @@ -414,7 +414,7 @@ type X = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Types(types = [ SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ @@ -448,7 +448,7 @@ type Z with """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType1 @@ -485,7 +485,7 @@ val InferSynValData: """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Val(valSig = SynValSig(synType = SynType.Fun( diff --git a/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs b/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs index 190f2664574..f7d96c3a7ea 100644 --- a/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs +++ b/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs @@ -13,7 +13,7 @@ let ``__LINE__`` () = __LINE__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__LINE__", "2", range), _)) ]) ])) -> assertRange (2, 0) (2, 8) range @@ -27,7 +27,7 @@ let ``__SOURCE_DIRECTORY__`` () = __SOURCE_DIRECTORY__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__SOURCE_DIRECTORY__", _, range), _)) ]) ])) -> assertRange (2, 0) (2, 20) range @@ -41,7 +41,7 @@ let ``__SOURCE_FILE__`` () = __SOURCE_FILE__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__SOURCE_FILE__", _, range), _)) ]) ])) -> assertRange (2, 0) (2, 15) range diff --git a/tests/service/SyntaxTreeTests/StringTests.fs b/tests/service/SyntaxTreeTests/StringTests.fs index d75384d8f60..c562b2450a6 100644 --- a/tests/service/SyntaxTreeTests/StringTests.fs +++ b/tests/service/SyntaxTreeTests/StringTests.fs @@ -7,7 +7,7 @@ open FsUnit let private getBindingExpressionValue (parseResults: ParsedInput) = match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> + | ParsedInput.ImplFile (ParsedImplFileInput (contents = modules)) -> modules |> List.tryPick (fun (SynModuleOrNamespace (decls = decls)) -> decls |> List.tryPick (fun decl -> match decl with diff --git a/tests/service/SyntaxTreeTests/SynIdentTests.fs b/tests/service/SyntaxTreeTests/SynIdentTests.fs new file mode 100644 index 00000000000..aa16871a609 --- /dev/null +++ b/tests/service/SyntaxTreeTests/SynIdentTests.fs @@ -0,0 +1,31 @@ +module FSharp.Compiler.Service.Tests.SyntaxTreeTests.SynIdentTests + +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Syntax +open FSharp.Compiler.Text +open NUnit.Framework + +[] +let ``Incomplete long ident`` () = + let ast = + """ +module Module + +A. +""" + |> getParseResults + + match ast with + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = + [ SynModuleDecl.Expr(expr = SynExpr.LongIdent (longDotId = lid)) ]) ])) -> + Assert.AreEqual(1, lid.IdentsWithTrivia.Length) + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + +[] +let ``IdentsWithTrivia with unbalance collection should not throw`` () = + let synLongIdent = + SynLongIdent([ Ident("A", Range.Zero); Ident("B", Range.Zero) ], [ Range.Zero ], [ None ]) + + match synLongIdent.IdentsWithTrivia with + | [ SynIdent (_, None); SynIdent (_, None) ] -> Assert.Pass() + | identsWithTrivia -> Assert.Fail $"Unexpected identsWithTrivia, got {identsWithTrivia}" diff --git a/tests/service/SyntaxTreeTests/SynTypeTests.fs b/tests/service/SyntaxTreeTests/SynTypeTests.fs new file mode 100644 index 00000000000..1ab5ed12e94 --- /dev/null +++ b/tests/service/SyntaxTreeTests/SynTypeTests.fs @@ -0,0 +1,51 @@ +module FSharp.Compiler.Service.Tests.SyntaxTreeTests.SynTypeTests + +open FSharp.Compiler.Service.Tests.Common +open FSharp.Compiler.Syntax +open NUnit.Framework + +[] +let ``SynType.Tuple does include leading parameter name`` () = + let parseResults = + getParseResultsOfSignatureFile + """ +type T = + member M: p1: a * p2: b -> int + """ + + match parseResults with + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ + SynModuleOrNamespaceSig(decls = [ + SynModuleSigDecl.Types(types = [ + SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ + SynMemberSig.Member(memberSig = SynValSig(synType = + SynType.Fun(argType = SynType.Tuple(_, _, mTuple)))) + ])) + ]) + ]) + ])) -> + assertRange (3, 14) (3, 27) mTuple + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" + +[] +let ``SynType.Tuple does include leading parameter attributes`` () = + let parseResults = + getParseResultsOfSignatureFile + """ +type T = + member M: [] a * [] b -> int + """ + + match parseResults with + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ + SynModuleOrNamespaceSig(decls = [ + SynModuleSigDecl.Types(types = [ + SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ + SynMemberSig.Member(memberSig = SynValSig(synType = + SynType.Fun(argType = SynType.Tuple(_, _, mTuple)))) + ])) + ]) + ]) + ])) -> + assertRange (3, 14) (3, 56) mTuple + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" diff --git a/tests/service/SyntaxTreeTests/TypeTests.fs b/tests/service/SyntaxTreeTests/TypeTests.fs index 0c822ea94dc..c006a7cd529 100644 --- a/tests/service/SyntaxTreeTests/TypeTests.fs +++ b/tests/service/SyntaxTreeTests/TypeTests.fs @@ -14,7 +14,7 @@ type Foo = One = 0x00000001 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r) ])))]) @@ -33,7 +33,7 @@ type Foo = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r1) @@ -54,7 +54,7 @@ type Bar = end""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [t]) as types ]) ])) -> assertRange (2, 0) (5, 7) types.Range @@ -77,7 +77,7 @@ and [] Bar<'context, 'a> = }""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [t1;t2]) as types ]) ])) -> assertRange (2, 0) (10, 5) types.Range @@ -94,7 +94,7 @@ type X = delegate of string -> string """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _) trivia={ EqualsRange = Some mEquals }) ] @@ -114,7 +114,7 @@ type Foobar () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = SynTypeDefnKind.Class) trivia={ EqualsRange = Some mEquals }) ] @@ -134,7 +134,7 @@ type Bear = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -160,7 +160,7 @@ type Shape = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Union _) trivia={ EqualsRange = Some mEquals }) ] @@ -169,26 +169,6 @@ type Shape = assertRange (2, 11) (2, 12) mEquals | _ -> Assert.Fail "Could not get valid AST" -[] -let ``SynTypeDefn with AutoProperty contains the range of the equals sign`` () = - let parseResults = - getParseResults - """ -/// mutable class with auto-properties -type Person(name : string, age : int) = - /// Full name - member val Name = name with get, set -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ ; SynMemberDefn.AutoProperty(equalsRange = mEquals)])) ] - ) - ]) ])) -> - assertRange (5, 20) (5, 21) mEquals - | _ -> Assert.Fail "Could not get valid AST" - [] let ``SynTypeDefn with Record contains the range of the with keyword`` () = let parseResults = @@ -201,7 +181,7 @@ type Foo = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr=SynTypeDefnRepr.Simple(simpleRepr= SynTypeDefnSimpleRepr.Record _) trivia={ WithKeyword = Some mWithKeyword }) ] @@ -220,7 +200,7 @@ type Int32 with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation mWithKeyword)) ] ) @@ -240,7 +220,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ SynMemberDefn.ImplicitCtor _ SynMemberDefn.Interface(withKeyword=Some mWithKeyword) @@ -250,115 +230,6 @@ type Foo() = assertRange (3, 18) (3, 22) mWithKeyword | _ -> Assert.Fail "Could not get valid AST" -[] -let ``SynTypeDefn with AutoProperty contains the range of the with keyword`` () = - let parseResults = - getParseResults - """ -type Foo() = - member val AutoProperty = autoProp with get, set - member val AutoProperty2 = autoProp -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ - SynMemberDefn.AutoProperty(withKeyword=Some mWith) - SynMemberDefn.AutoProperty(withKeyword=None)])) ] - ) - ]) ])) -> - assertRange (3, 39) (3, 43) mWith - | _ -> Assert.Fail "Could not get valid AST" - -[] -let ``SynTypeDefn with AbstractSlot contains the range of the with keyword`` () = - let parseResults = - getParseResults - """ -type Foo() = - abstract member Bar : int with get,set -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ - SynMemberDefn.AbstractSlot(slotSig=SynValSig(trivia = { WithKeyword = Some mWith }))])) ] - ) - ]) ])) -> - assertRange (3, 30) (3, 34) mWith - | _ -> Assert.Fail "Could not get valid AST" - -[] -let ``read-only property in SynMemberDefn.Member contains the range of the with keyword`` () = - let parseResults = - getParseResults - """ -type Foo() = - // A read-only property. - member this.MyReadProperty with get () = myInternalValue -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = - SynTypeDefnRepr.ObjectModel(members=[ - _ - SynMemberDefn.GetSetMember(Some(SynBinding _), None, _, { WithKeyword = mWith }) ]) - ) ]) - ]) ])) -> - assertRange (4, 31) (4, 35) mWith - | _ -> Assert.Fail "Could not get valid AST" - -[] -let ``write-only property in SynMemberDefn.Member contains the range of the with keyword`` () = - let parseResults = - getParseResults - """ -type Foo() = - // A write-only property. - member this.MyWriteOnlyProperty with set (value) = myInternalValue <- value -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = - SynTypeDefnRepr.ObjectModel(members=[ - _ - SynMemberDefn.GetSetMember(None, Some(SynBinding _), _, { WithKeyword = mWith }) ]) - ) ]) - ]) ])) -> - assertRange (4, 36) (4, 40) mWith - | _ -> Assert.Fail "Could not get valid AST" - -[] -let ``read/write property in SynMemberDefn.Member contains the range of the with keyword`` () = - let parseResults = - getParseResults - """ -type Foo() = - // A read-write property. - member this.MyReadWriteProperty - with get () = myInternalValue - and set (value) = myInternalValue <- value -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = - SynTypeDefnRepr.ObjectModel(members=[ - _ - SynMemberDefn.GetSetMember(Some _, Some _, _, { WithKeyword = mWith; AndKeyword = Some mAnd }) ]) - ) ]) - ]) ])) -> - assertRange (5, 8) (5, 12) mWith - assertRange (6, 8) (6, 11) mAnd - | _ -> Assert.Fail "Could not get valid AST" - [] let ``SynTypeDefn with XmlDoc contains the range of the type keyword`` () = let parseResults = @@ -371,7 +242,7 @@ and C = D """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(trivia={ TypeKeyword = Some mType }) SynTypeDefn(trivia={ TypeKeyword = None }) ] @@ -391,7 +262,7 @@ type A = B """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(trivia={ TypeKeyword = Some mType }) ] ) @@ -399,70 +270,6 @@ type A = B assertRange (4, 0) (4, 4) mType | _ -> Assert.Fail "Could not get valid AST" -[] -let ``SynTypeDefn with static member with get/set`` () = - let parseResults = - getParseResults - """ -type Foo = - static member ReadWrite2 - with set x = lastUsed <- ("ReadWrite2", x) - and get () = lastUsed <- ("ReadWrite2", 0); 4 -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ - SynMemberDefn.GetSetMember(Some _, Some _, m, { WithKeyword = mWith - GetKeyword = Some mGet - AndKeyword = Some mAnd - SetKeyword = Some mSet }) - ])) ] - ) - ]) ])) -> - assertRange (4, 8) (4, 12) mWith - assertRange (4, 13) (4, 16) mSet - assertRange (5, 8) (5, 11) mAnd - assertRange (5, 13) (5, 16) mGet - assertRange (3, 4) (5, 54) m - | _ -> Assert.Fail "Could not get valid AST" - -[] -let ``SynTypeDefn with member with set/get`` () = - let parseResults = - getParseResults - """ -type A() = - member this.Z with set (_:int):unit = () and get():int = 1 -""" - - match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ - SynModuleDecl.Types( - typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ - SynMemberDefn.ImplicitCtor _ - SynMemberDefn.GetSetMember(Some (SynBinding(headPat = SynPat.LongIdent(extraId = Some getIdent))), - Some (SynBinding(headPat = SynPat.LongIdent(extraId = Some setIdent))), - m, - { WithKeyword = mWith - GetKeyword = Some mGet - AndKeyword = Some mAnd - SetKeyword = Some mSet }) - ])) ] - ) - ]) ])) -> - Assert.AreEqual("get", getIdent.idText) - Assert.AreEqual("set", setIdent.idText) - assertRange (3, 18) (3, 22) mWith - assertRange (3, 23) (3, 26) mSet - assertRange (3, 23) (3, 26) setIdent.idRange - assertRange (3, 45) (3, 48) mAnd - assertRange (3, 49) (3, 52) mGet - assertRange (3, 49) (3, 52) getIdent.idRange - assertRange (3, 4) (3, 62) m - | _ -> Assert.Fail "Could not get valid AST" - [] let ``SynType.Fun has range of arrow`` () = let parseResults = @@ -473,7 +280,7 @@ let ``SynType.Fun has range of arrow`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = @@ -494,7 +301,7 @@ let _: struct (int * int) = () """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(true, [ SynTupleTypeSegment.Type _ ; SynTupleTypeSegment.Star _ ; SynTupleTypeSegment.Type _ ], mTuple)))) ]) @@ -502,7 +309,7 @@ let _: struct (int * int) = () ]) ) -> assertRange (2, 7) (2, 25) mTuple - + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" [] @@ -514,7 +321,7 @@ let _: struct (int * int = () """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(true, [ SynTupleTypeSegment.Type _ ; SynTupleTypeSegment.Star _ ; SynTupleTypeSegment.Type _ ], mTuple)))) ]) @@ -522,7 +329,7 @@ let _: struct (int * int = () ]) ) -> assertRange (2, 7) (2, 24) mTuple - + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" [] @@ -534,7 +341,7 @@ type Foo = delegate of a: A * b: B -> c:C -> D """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = @@ -569,7 +376,7 @@ type X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel( @@ -593,4 +400,4 @@ type X = ])) -> Assert.AreEqual("a", a.idText) assertRange (3, 23) (3, 41) m - | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" \ No newline at end of file + | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" diff --git a/tests/service/SyntaxTreeTests/UnionCaseTests.fs b/tests/service/SyntaxTreeTests/UnionCaseTests.fs index c9c480cc16e..c40a3ecc232 100644 --- a/tests/service/SyntaxTreeTests/UnionCaseTests.fs +++ b/tests/service/SyntaxTreeTests/UnionCaseTests.fs @@ -19,7 +19,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -50,7 +50,7 @@ type Foo = | Bar of string |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -73,7 +73,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -96,7 +96,7 @@ type Foo = Bar of string |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -124,7 +124,7 @@ type Currency = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union( @@ -147,7 +147,7 @@ type X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = diff --git a/tests/service/XmlDocTests.fs b/tests/service/XmlDocTests.fs index 76bce785065..cb0266e55ff 100644 --- a/tests/service/XmlDocTests.fs +++ b/tests/service/XmlDocTests.fs @@ -17,12 +17,12 @@ open FsUnit open NUnit.Framework let (|Types|TypeSigs|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(range = range; typeDefns = types)])])) -> Types(range, types) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(range = range; types = types)])])) -> TypeSigs(range, types) @@ -38,34 +38,34 @@ let (|TypeSigRange|) = function typeRange, componentInfoRange let (|Module|NestedModules|NestedModulesSigs|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule(range = range1) SynModuleDecl.NestedModule(range = range2)])])) -> NestedModules(range1, range2) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule(range = range1) SynModuleSigDecl.NestedModule(range = range2)])])) -> NestedModulesSigs(range1, range2) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> Module(range) | x -> failwith $"Unexpected ParsedInput %A{x}" let (|Exception|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Exception(range = range; exnDefn = SynExceptionDefn(range = exnDefnRange; exnRepr = SynExceptionDefnRepr(range = exnDefnReprRange)))])])) -> Exception(range, exnDefnRange, exnDefnReprRange) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Exception(range = range; exnSig = SynExceptionSig(range = exnSpfnRange; exnRepr = @@ -99,26 +99,26 @@ let (|Members|MemberSigs|) = function | x -> failwith $"Unexpected ParsedInput %A{x}" let (|Decls|LetBindings|ValSig|LetOrUse|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(expr = SynExpr.LetOrUse(range = range; bindings = bindings))])])])) -> LetOrUse(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(range = range; bindings = bindings)])])) -> LetBindings(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LetOrUse(range = range; bindings = bindings))])])) -> LetBindings(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = decls)])) -> Decls(decls) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(range = valSigRange); range = range)])])) -> ValSig(range, valSigRange) @@ -1374,8 +1374,8 @@ namespace N checkParsingErrors [|Information 3520, Line 2, Col 0, Line 2, Col 4, "XML comment is not placed on a valid language element."|] match parseResults.ParseTree with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) + | ParsedInput.SigFile(ParsedSigFileInput(contents = [SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> assertRange (3, 0) (3, 11) range | x -> failwith $"Unexpected ParsedInput %A{x}") diff --git a/vsintegration/src/FSharp.Editor/CodeLens/AbstractCodeLensDisplayService.fs b/vsintegration/src/FSharp.Editor/CodeLens/AbstractCodeLensDisplayService.fs index ba21dabebde..c4d63c83b4d 100644 --- a/vsintegration/src/FSharp.Editor/CodeLens/AbstractCodeLensDisplayService.fs +++ b/vsintegration/src/FSharp.Editor/CodeLens/AbstractCodeLensDisplayService.fs @@ -1,8 +1,10 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace rec Microsoft.VisualStudio.FSharp.Editor +namespace Microsoft.VisualStudio.FSharp.Editor +open System open System.Windows.Controls +open Microsoft.VisualStudio.FSharp.Editor.Logging open Microsoft.VisualStudio.Text open Microsoft.VisualStudio.Text.Editor open Microsoft.VisualStudio.Text.Formatting @@ -10,10 +12,7 @@ open System.Threading open System.Windows open System.Collections.Generic -open Microsoft.VisualStudio.FSharp.Editor.Logging - -[] -type CodeLensDisplayService (view : IWpfTextView, buffer : ITextBuffer, layerName) as self = +type CodeLensDisplayService (view : IWpfTextView, buffer : ITextBuffer) as self = // Add buffer changed event handler do ( @@ -47,7 +46,7 @@ type CodeLensDisplayService (view : IWpfTextView, buffer : ITextBuffer, layerNam /// Text view for accessing the adornment layer. member val View: IWpfTextView = view - member val CodeLensLayer = view.GetAdornmentLayer layerName + member val CodeLensLayer = view.GetAdornmentLayer "LineLens" /// Tracks the recent first + last visible line numbers for adornment layout logic. member val RecentFirstVsblLineNmbr = 0 with get, set @@ -201,23 +200,20 @@ type CodeLensDisplayService (view : IWpfTextView, buffer : ITextBuffer, layerNam logWarningf "No tracking span is accociated with this line number %d!" lineNumber #endif - abstract member AddUiElementToCodeLens : ITrackingSpan * UIElement -> unit - default self.AddUiElementToCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement) = + member self.AddUiElementToCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement) = let Grid = self.UiElements.[trackingSpan] Grid.Children.Add uiElement |> ignore - abstract member AddUiElementToCodeLensOnce : ITrackingSpan * UIElement -> unit - default self.AddUiElementToCodeLensOnce (trackingSpan:ITrackingSpan, uiElement:UIElement)= + member self.AddUiElementToCodeLensOnce (trackingSpan:ITrackingSpan, uiElement:UIElement)= let Grid = self.UiElements.[trackingSpan] if uiElement |> Grid.Children.Contains |> not then self.AddUiElementToCodeLens (trackingSpan, uiElement) - abstract member RemoveUiElementFromCodeLens : ITrackingSpan * UIElement -> unit - default self.RemoveUiElementFromCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement) = + member self.RemoveUiElementFromCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement) = let Grid = self.UiElements.[trackingSpan] Grid.Children.Remove(uiElement) |> ignore - member self.HandleLayoutChanged (e:TextViewLayoutChangedEventArgs) = + member self.HandleLayoutChanged (e:TextViewLayoutChangedEventArgs) = try // We can cancel existing stuff because the algorithm supports abortion without any data loss self.LayoutChangedCts.Cancel() @@ -299,6 +295,54 @@ type CodeLensDisplayService (view : IWpfTextView, buffer : ITextBuffer, layerNam ignore e #endif - abstract LayoutUIElementOnLine : IWpfTextView -> ITextViewLine -> Grid -> unit - - abstract AsyncCustomLayoutOperation : int Set -> ITextSnapshot -> unit Async \ No newline at end of file + /// Layouts all stack panels on the line + member self.LayoutUIElementOnLine _ (line:ITextViewLine) (ui:Grid) = + let left, top = + try + let bounds = line.GetCharacterBounds(line.Start) + line.TextRight + 5.0, bounds.Top - 1. + with e -> +#if DEBUG + logExceptionWithContext (e, "Error in layout ui element on line") +#else + ignore e +#endif + Canvas.GetLeft ui, Canvas.GetTop ui + Canvas.SetLeft(ui, left) + Canvas.SetTop(ui, top) + + member self.AsyncCustomLayoutOperation visibleLineNumbers buffer = + asyncMaybe { + // Suspend 5 ms, instantly applying the layout to the adornment elements isn't needed + // and would consume too much performance + do! Async.Sleep(5) |> liftAsync // Skip at least one frames + do! Async.SwitchToContext self.UiContext |> liftAsync + let layer = self.CodeLensLayer + do! Async.Sleep(495) |> liftAsync + try + for visibleLineNumber in visibleLineNumbers do + if self.TrackingSpans.ContainsKey visibleLineNumber then + self.TrackingSpans.[visibleLineNumber] + |> Seq.map (fun trackingSpan -> + let success, res = self.UiElements.TryGetValue trackingSpan + if success then + res + else null + ) + |> Seq.filter (fun ui -> not(isNull ui) && not(self.AddedAdornments.Contains ui)) + |> Seq.iter(fun grid -> + layer.AddAdornment(AdornmentPositioningBehavior.OwnerControlled, Nullable(), + self, grid, AdornmentRemovedCallback(fun _ _ -> self.AddedAdornments.Remove grid |> ignore)) |> ignore + self.AddedAdornments.Add grid |> ignore + let line = + let l = buffer.GetLineFromLineNumber visibleLineNumber + view.GetTextViewLineContainingBufferPosition l.Start + self.LayoutUIElementOnLine view line grid + ) + with e -> +#if DEBUG + logExceptionWithContext (e, "LayoutChanged, processing new visible lines") +#else + ignore e +#endif + } |> Async.Ignore \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensGeneralTagger.fs b/vsintegration/src/FSharp.Editor/CodeLens/CodeLensGeneralTagger.fs deleted file mode 100644 index fbc54c1e5fc..00000000000 --- a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensGeneralTagger.fs +++ /dev/null @@ -1,191 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace rec Microsoft.VisualStudio.FSharp.Editor - -open System -open System.Windows.Controls -open Microsoft.VisualStudio.Text -open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Text.Formatting -open System.Windows -open Microsoft.VisualStudio.Text.Tagging - -open Microsoft.VisualStudio.FSharp.Editor.Logging - -type CodeLensGeneralTag(width, topSpace, baseline, textHeight, bottomSpace, affinity, tag:obj, providerTag:obj) = - inherit SpaceNegotiatingAdornmentTag(width, topSpace, baseline, textHeight, bottomSpace, affinity, tag, providerTag) - -/// Class which provides support for general code lens -/// Use the methods AddCodeLens and RemoveCodeLens -type CodeLensGeneralTagger (view, buffer) as self = - inherit CodeLensDisplayService(view, buffer, "CodeLens") - - /// The tags changed event to notify if the data for the tags has changed. - let tagsChangedEvent = new Event,SnapshotSpanEventArgs>() - - /// Layouts all stack panels on the line - override self.LayoutUIElementOnLine (view:IWpfTextView) (line:ITextViewLine) (ui:Grid) = - let left, top = - match self.UiElementNeighbour.TryGetValue ui with - | true, parent -> - let left = Canvas.GetLeft parent - let top = Canvas.GetTop parent - let width = parent.ActualWidth -#if DEBUG - logInfof "Width of parent: %.4f" width -#endif - left + width, top - | _ -> - try - // Get the real offset so that the code lens are placed respectively to their content - let offset = - [0..line.Length - 1] |> Seq.tryFind (fun i -> not (Char.IsWhiteSpace (line.Start.Add(i).GetChar()))) - |> Option.defaultValue 0 - - let realStart = line.Start.Add(offset) - let g = view.TextViewLines.GetCharacterBounds(realStart) - // WORKAROUND VS BUG, left cannot be zero if the offset is creater than zero! - // Calling the method twice fixes this bug and ensures that all values are correct. - // Okay not really :( Must be replaced later with an own calculation depending on editor font settings! - if 7 * offset > int g.Left then -#if DEBUG - logErrorf "Incorrect return from geometry measure" -#endif - Canvas.GetLeft ui, g.Top - else - g.Left, g.Top - with e -> -#if DEBUG - logExceptionWithContext (e, "Error in layout ui element on line") -#else - ignore e -#endif - Canvas.GetLeft ui, Canvas.GetTop ui - Canvas.SetLeft(ui, left) - Canvas.SetTop(ui, top) - - override self.AsyncCustomLayoutOperation _ _ = - asyncMaybe { - // Suspend 16 ms, instantly applying the layout to the adornment elements isn't needed - // and would consume too much performance - do! Async.Sleep(16) |> liftAsync // Skip at least one frames - do! Async.SwitchToContext self.UiContext |> liftAsync - let layer = self.CodeLensLayer - - do! Async.Sleep(495) |> liftAsync - - // WORKAROUND FOR VS BUG - // The layout changed event may not provide us all real changed lines so - // we take care of this on our own. - let visibleSpan = - let first, last = - view.TextViewLines.FirstVisibleLine, - view.TextViewLines.LastVisibleLine - SnapshotSpan(first.Start, last.End) - let customVisibleLines = view.TextViewLines.GetTextViewLinesIntersectingSpan visibleSpan - let isLineVisible (line:ITextViewLine) = line.IsValid - let linesToProcess = customVisibleLines |> Seq.filter isLineVisible - - for line in linesToProcess do - try - match line.GetAdornmentTags self |> Seq.tryHead with - | Some (:? seq as stackPanels) -> - for stackPanel in stackPanels do - if stackPanel |> self.AddedAdornments.Contains |> not then - layer.AddAdornment(AdornmentPositioningBehavior.OwnerControlled, Nullable(), - self, stackPanel, AdornmentRemovedCallback(fun _ _ -> ())) |> ignore - self.AddedAdornments.Add stackPanel |> ignore - | _ -> () - with e -> -#if DEBUG - logExceptionWithContext (e, "LayoutChanged, processing new visible lines") -#else - ignore e -#endif - } |> Async.Ignore - - override self.AddUiElementToCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement)= - base.AddUiElementToCodeLens (trackingSpan, uiElement) // We do the same as the base call execpt that we need to notify that the tag needs to be refreshed. - tagsChangedEvent.Trigger(self, SnapshotSpanEventArgs(trackingSpan.GetSpan(buffer.CurrentSnapshot))) - - override self.RemoveUiElementFromCodeLens (trackingSpan:ITrackingSpan, uiElement:UIElement) = - base.RemoveUiElementFromCodeLens (trackingSpan, uiElement) - tagsChangedEvent.Trigger(self, SnapshotSpanEventArgs(trackingSpan.GetSpan(buffer.CurrentSnapshot))) // Need to refresh the tag. - - interface ITagger with - [] - override _.TagsChanged = tagsChangedEvent.Publish - - /// Returns the tags which reserve the correct space for adornments - /// Notice, it's asumed that the data in the collection is valid. - override _.GetTags spans = - try - seq { - for span in spans do - let snapshot = span.Snapshot - let lineNumber = - try - snapshot.GetLineNumberFromPosition(span.Start.Position) - with e -> -#if DEBUG - logExceptionWithContext (e, "line number tagging") -#else - ignore e -#endif - 0 - if self.TrackingSpans.ContainsKey(lineNumber) && self.TrackingSpans.[lineNumber] |> Seq.isEmpty |> not then - - let tagSpan = snapshot.GetLineFromLineNumber(lineNumber).Extent - let stackPanels = - self.TrackingSpans.[lineNumber] - |> Seq.map (fun trackingSpan -> - let success, res = self.UiElements.TryGetValue trackingSpan - if success then res else null - ) - |> Seq.filter (isNull >> not) - let span = - try - tagSpan.TranslateTo(span.Snapshot, SpanTrackingMode.EdgeExclusive) - with e -> -#if DEBUG - logExceptionWithContext (e, "tag span translation") -#else - ignore e -#endif - tagSpan - let sizes = - try - stackPanels |> Seq.map (fun ui -> - ui.Measure(Size(10000., 10000.)) - ui.DesiredSize ) - with e -> -#if DEBUG - logExceptionWithContext (e, "internal tagging") -#else - ignore e -#endif - Seq.empty - let height = - try - sizes - |> Seq.map (fun size -> size.Height) - |> Seq.sortDescending - |> Seq.tryHead - |> Option.defaultValue 0. - with e -> -#if DEBUG - logExceptionWithContext (e, "height tagging") -#else - ignore e -#endif - 0.0 - - yield TagSpan(span, CodeLensGeneralTag(0., height, 0., 0., 0., PositionAffinity.Predecessor, stackPanels, self)) :> ITagSpan - } - with e -> -#if DEBUG - logErrorf "Error in code lens get tags %A" e -#else - ignore e -#endif - Seq.empty \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs b/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs index 8d3be2fcf35..5f2991b909e 100644 --- a/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs +++ b/vsintegration/src/FSharp.Editor/CodeLens/CodeLensProvider.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace rec Microsoft.VisualStudio.FSharp.Editor +namespace Microsoft.VisualStudio.FSharp.Editor open System open Microsoft.VisualStudio.Text @@ -15,7 +15,6 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.Shared.Utilities [)>] [)>] -[)>] [] [] type internal CodeLensProvider @@ -28,75 +27,37 @@ type internal CodeLensProvider settings: EditorOptions ) = - let lineLensProvider = ResizeArray() - let taggers = ResizeArray() + let tryGetTextDocument (buffer: ITextBuffer) (factory: ITextDocumentFactoryService) = + match factory.TryGetTextDocument buffer with + | true, document -> Some document + | _ -> None + + let lineLensProviders = ResizeArray() let componentModel = Package.GetGlobalService(typeof) :?> ComponentModelHost.IComponentModel let workspace = componentModel.GetService() - /// Returns an provider for the textView if already one has been created. Else create one. - let addCodeLensProviderOnce wpfView buffer = - let res = taggers |> Seq.tryFind(fun (view, _) -> view = wpfView) - match res with - | Some (_, (tagger, _)) -> tagger - | None -> - let documentId = - lazy ( - match textDocumentFactory.TryGetTextDocument(buffer) with - | true, textDocument -> - Seq.tryHead (workspace.CurrentSolution.GetDocumentIdsWithFilePath(textDocument.FilePath)) - | _ -> None - |> Option.get - ) - - let tagger = CodeLensGeneralTagger(wpfView, buffer) - let service = FSharpCodeLensService(serviceProvider, workspace, documentId, buffer, metadataAsSource, componentModel.GetService(), typeMap, tagger, settings) - let provider = (wpfView, (tagger, service)) - wpfView.Closed.Add (fun _ -> taggers.Remove provider |> ignore) - taggers.Add((wpfView, (tagger, service))) - tagger - - /// Returns an provider for the textView if already one has been created. Else create one. - let addLineLensProviderOnce wpfView buffer = - let res = lineLensProvider |> Seq.tryFind(fun (view, _) -> view = wpfView) - match res with - | None -> - let documentId = - lazy ( - match textDocumentFactory.TryGetTextDocument(buffer) with - | true, textDocument -> - Seq.tryHead (workspace.CurrentSolution.GetDocumentIdsWithFilePath(textDocument.FilePath)) - | _ -> None - |> Option.get - ) - let service = FSharpCodeLensService(serviceProvider, workspace, documentId, buffer, metadataAsSource, componentModel.GetService(), typeMap, LineLensDisplayService(wpfView, buffer), settings) + let addLineLensProvider wpfView buffer = + textDocumentFactory + |> tryGetTextDocument buffer + |> Option.map (fun document -> workspace.CurrentSolution.GetDocumentIdsWithFilePath(document.FilePath)) + |> Option.bind Seq.tryHead + |> Option.map (fun documentId -> + let service = FSharpCodeLensService(serviceProvider, workspace, documentId, buffer, metadataAsSource, componentModel.GetService(), typeMap, CodeLensDisplayService(wpfView, buffer), settings) let provider = (wpfView, service) - wpfView.Closed.Add (fun _ -> lineLensProvider.Remove provider |> ignore) - lineLensProvider.Add(provider) - | _ -> () + wpfView.Closed.Add (fun _ -> lineLensProviders.Remove provider |> ignore) + lineLensProviders.Add(provider)) - [); Name("CodeLens"); - Order(Before = PredefinedAdornmentLayers.Text); - TextViewRole(PredefinedTextViewRoles.Document)>] - member val CodeLensAdornmentLayerDefinition : AdornmentLayerDefinition = null with get, set - [); Name("LineLens"); Order(Before = PredefinedAdornmentLayers.Text); TextViewRole(PredefinedTextViewRoles.Document)>] member val LineLensAdornmentLayerDefinition : AdornmentLayerDefinition = null with get, set - interface IViewTaggerProvider with - override _.CreateTagger(view, buffer) = - if settings.CodeLens.Enabled && not settings.CodeLens.ReplaceWithLineLens then - let wpfView = - match view with - | :? IWpfTextView as view -> view - | _ -> failwith "error" - - box(addCodeLensProviderOnce wpfView buffer) :?> _ - else - null - interface IWpfTextViewCreationListener with override _.TextViewCreated view = - if settings.CodeLens.Enabled && settings.CodeLens.ReplaceWithLineLens then - addLineLensProviderOnce view (view.TextBuffer) |> ignore \ No newline at end of file + if settings.CodeLens.Enabled then + let provider = + lineLensProviders + |> Seq.tryFind (fun (v, _) -> v = view) + + if provider.IsNone then + addLineLensProvider view (view.TextBuffer) |> ignore \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/CodeLens/FSharpCodeLensService.fs b/vsintegration/src/FSharp.Editor/CodeLens/FSharpCodeLensService.fs index 2e18270e97e..da389c2fb4a 100644 --- a/vsintegration/src/FSharp.Editor/CodeLens/FSharpCodeLensService.fs +++ b/vsintegration/src/FSharp.Editor/CodeLens/FSharpCodeLensService.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace rec Microsoft.VisualStudio.FSharp.Editor +namespace Microsoft.VisualStudio.FSharp.Editor open System @@ -12,18 +12,12 @@ open System.Windows.Media open System.Windows.Media.Animation open Microsoft.CodeAnalysis -open Microsoft.CodeAnalysis.Editor.Shared.Extensions open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.Shared.Extensions -open FSharp.Compiler.CodeAnalysis -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax open FSharp.Compiler.Text -open FSharp.Compiler.Text -open FSharp.Compiler.Tokenization open Microsoft.VisualStudio.FSharp.Editor.Logging open Microsoft.VisualStudio.Shell.Interop @@ -32,17 +26,17 @@ open Microsoft.VisualStudio.Text.Classification open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Editor.Shared.Utilities -type internal CodeLens(taggedText, computed, fullTypeSignature, uiElement) = +type internal CodeLens(taggedText, computed, funcID, uiElement) = member val TaggedText: Async<(ResizeArray * FSharpNavigation) option> = taggedText member val Computed: bool = computed with get, set - member val FullTypeSignature: string = fullTypeSignature + member val FuncID: string = funcID member val UiElement: UIElement = uiElement with get, set type internal FSharpCodeLensService ( serviceProvider: IServiceProvider, workspace: Workspace, - documentId: Lazy, + documentId: DocumentId, buffer: ITextBuffer, metadataAsSource: FSharpMetadataAsSourceService, classificationFormatMapService: IClassificationFormatMapService, @@ -153,7 +147,7 @@ type internal FSharpCodeLensService #if DEBUG logInfof "Rechecking code due to buffer edit!" #endif - let! document = workspace.CurrentSolution.GetDocument(documentId.Value) |> Option.ofObj + let! document = workspace.CurrentSolution.GetDocument documentId |> Option.ofObj let! parseFileResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync(nameof(FSharpUseMutationWhenValueIsMutableFixProvider)) |> liftAsync let parsedInput = parseFileResults.ParseTree #if DEBUG @@ -221,14 +215,12 @@ type internal FSharpCodeLensService match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as func when func.IsModuleValueOrMember || func.IsProperty -> let funcID = func.LogicalName + (func.FullType.ToString() |> hash |> string) - // Use a combination of the the function name + the hashed value of the type signature - let fullTypeSignature = func.FullType.ToString() // Try to re-use the last results if lastResults.ContainsKey funcID then // Make sure that the results are usable let inline setNewResultsAndWarnIfOverridenLocal value = setNewResultsAndWarnIfOverriden funcID value let lastTrackingSpan, codeLens as lastResult = lastResults.[funcID] - if codeLens.FullTypeSignature = fullTypeSignature then + if codeLens.FuncID = funcID then setNewResultsAndWarnIfOverridenLocal lastResult oldResults.Remove funcID |> ignore else @@ -247,7 +239,7 @@ type internal FSharpCodeLensService let res = CodeLens( Async.cache (useResults (symbolUse.DisplayContext, func, range)), false, - fullTypeSignature, + funcID, null) // The old results aren't computed at all, because the line might have changed create new results tagsToUpdate.[lastTrackingSpan] <- (newTrackingSpan, funcID, res) @@ -257,12 +249,12 @@ type internal FSharpCodeLensService else // The symbol might be completely new or has slightly changed. // We need to track this and iterate over the left entries to ensure that there isn't anything - unattachedSymbols.Add((symbolUse, func, funcID, fullTypeSignature)) + unattachedSymbols.Add(symbolUse, func, funcID) | _ -> () // In best case this works quite `covfefe` fine because often enough we change only a small part of the file and not the complete. for unattachedSymbol in unattachedSymbols do - let symbolUse, func, funcID, fullTypeSignature = unattachedSymbol + let symbolUse, func, funcID = unattachedSymbol let declarationLine, range = match visit func.DeclarationLocation.Start parsedInput with | Some range -> range.StartLine - 1, range @@ -270,7 +262,7 @@ type internal FSharpCodeLensService let test (v:KeyValuePair<_, _>) = let _, (codeLens:CodeLens) = v.Value - codeLens.FullTypeSignature = fullTypeSignature + codeLens.FuncID = funcID match oldResults |> Seq.tryFind test with | Some res -> let (trackingSpan : ITrackingSpan), (codeLens : CodeLens) = res.Value @@ -288,7 +280,7 @@ type internal FSharpCodeLensService CodeLens( Async.cache (useResults (symbolUse.DisplayContext, func, range)), false, - fullTypeSignature, + funcID, null) // The tag might be still valid but it hasn't been computed yet so create fresh results tagsToUpdate.[trackingSpan] <- (newTrackingSpan, funcID, res) @@ -303,7 +295,7 @@ type internal FSharpCodeLensService CodeLens( Async.cache (useResults (symbolUse.DisplayContext, func, range)), false, - fullTypeSignature, + funcID, null) try let declarationSpan = @@ -347,7 +339,7 @@ type internal FSharpCodeLensService sb.Begin() else #if DEBUG - logWarningf "Couldn't retrieve code lens information for %A" codeLens.FullTypeSignature + logWarningf "Couldn't retrieve code lens information for %A" codeLens.FuncID #endif () } |> (RoslynHelpers.StartAsyncSafe CancellationToken.None) "UIElement creation" diff --git a/vsintegration/src/FSharp.Editor/CodeLens/LineLensDisplayService.fs b/vsintegration/src/FSharp.Editor/CodeLens/LineLensDisplayService.fs deleted file mode 100644 index a34df51c722..00000000000 --- a/vsintegration/src/FSharp.Editor/CodeLens/LineLensDisplayService.fs +++ /dev/null @@ -1,73 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace rec Microsoft.VisualStudio.FSharp.Editor - - -open System -open System.Windows.Controls -open Microsoft.VisualStudio.Text.Editor -open Microsoft.VisualStudio.Text.Formatting - -open Microsoft.VisualStudio.FSharp.Editor.Logging - -type internal LineLensDisplayService (view, buffer) = - inherit CodeLensDisplayService(view, buffer, "LineLens") - - /// Layouts all stack panels on the line - override self.LayoutUIElementOnLine _ (line:ITextViewLine) (ui:Grid) = - let left, top = - match self.UiElementNeighbour.TryGetValue ui with - | true, parent -> - let left = Canvas.GetLeft parent - let top = Canvas.GetTop parent - let width = parent.ActualWidth - left + width, top - | _ -> - try - let bounds = line.GetCharacterBounds(line.Start) - line.TextRight + 5.0, bounds.Top - 1. - with e -> -#if DEBUG - logExceptionWithContext (e, "Error in layout ui element on line") -#else - ignore e -#endif - Canvas.GetLeft ui, Canvas.GetTop ui - Canvas.SetLeft(ui, left) - Canvas.SetTop(ui, top) - - override self.AsyncCustomLayoutOperation visibleLineNumbers buffer = - asyncMaybe { - // Suspend 5 ms, instantly applying the layout to the adornment elements isn't needed - // and would consume too much performance - do! Async.Sleep(5) |> liftAsync // Skip at least one frames - do! Async.SwitchToContext self.UiContext |> liftAsync - let layer = self.CodeLensLayer - do! Async.Sleep(495) |> liftAsync - try - for visibleLineNumber in visibleLineNumbers do - if self.TrackingSpans.ContainsKey visibleLineNumber then - self.TrackingSpans.[visibleLineNumber] - |> Seq.map (fun trackingSpan -> - let success, res = self.UiElements.TryGetValue trackingSpan - if success then - res - else null - ) - |> Seq.filter (fun ui -> not(isNull ui) && not(self.AddedAdornments.Contains ui)) - |> Seq.iter(fun grid -> - layer.AddAdornment(AdornmentPositioningBehavior.OwnerControlled, Nullable(), - self, grid, AdornmentRemovedCallback(fun _ _ -> self.AddedAdornments.Remove grid |> ignore)) |> ignore - self.AddedAdornments.Add grid |> ignore - let line = - let l = buffer.GetLineFromLineNumber visibleLineNumber - view.GetTextViewLineContainingBufferPosition l.Start - self.LayoutUIElementOnLine view line grid - ) - with e -> -#if DEBUG - logExceptionWithContext (e, "LayoutChanged, processing new visible lines") -#else - ignore e -#endif - } |> Async.Ignore \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 9ce0e102479..7021d1ae152 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -126,8 +126,6 @@ - - @@ -152,11 +150,9 @@ - - diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index 203867a6afe..ed20c78bf39 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -93,20 +93,39 @@ type internal FSharpWorkspaceServiceFactory match checkerSingleton with | Some _ -> () | _ -> - let checker = + let checker = lazy - let checker = + let editorOptions = + let editorOptions = workspace.Services.GetService() + + match box editorOptions with + | null -> None + | _ -> Some editorOptions + + let enableParallelCheckingWithSignatureFiles = + editorOptions + |> Option.map (fun options -> options.LanguageServicePerformance.EnableParallelCheckingWithSignatureFiles) + |> Option.defaultValue false + + let enableParallelReferenceResolution = + editorOptions + |> Option.map (fun options -> options.LanguageServicePerformance.EnableParallelReferenceResolution) + |> Option.defaultValue false + + let checker = FSharpChecker.Create( - projectCacheSize = 5000, // We do not care how big the cache is. VS will actually tell FCS to clear caches, so this is fine. + projectCacheSize = 5000, // We do not care how big the cache is. VS will actually tell FCS to clear caches, so this is fine. keepAllBackgroundResolutions = false, legacyReferenceResolver=LegacyMSBuildReferenceResolver.getResolver(), tryGetMetadataSnapshot = tryGetMetadataSnapshot, keepAllBackgroundSymbolUses = false, enableBackgroundItemKeyStoreAndSemanticClassification = true, - enablePartialTypeChecking = true) - checker - checkerSingleton <- Some checker - ) + enablePartialTypeChecking = true, + enableParallelCheckingWithSignatureFiles = enableParallelCheckingWithSignatureFiles, + parallelReferenceResolution = enableParallelReferenceResolution) + checker + checkerSingleton <- Some checker + ) let optionsManager = lazy diff --git a/vsintegration/src/FSharp.Editor/LanguageService/MetadataAsSource.fs b/vsintegration/src/FSharp.Editor/LanguageService/MetadataAsSource.fs index 0fe209093d0..6ac4e754c1f 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/MetadataAsSource.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/MetadataAsSource.fs @@ -99,11 +99,11 @@ type internal FSharpMetadataAsSourceService() = let serviceProvider = ServiceProvider.GlobalProvider let projs = System.Collections.Concurrent.ConcurrentDictionary() - let createMetadataProjectContext (projInfo: ProjectInfo) (docInfo: DocumentInfo) = + let createMetadataProjectContext (projFilePath: string) (projInfo: ProjectInfo) (docInfo: DocumentInfo) = let componentModel = Package.GetGlobalService(typeof) :?> ComponentModelHost.IComponentModel - let projectContextFactory = componentModel.GetService() + let projectContextFactory = componentModel.GetService() - let projectContext = projectContextFactory.CreateProjectContext(projInfo.FilePath, projInfo.Id.ToString()) + let projectContext = projectContextFactory.CreateProjectContext(projFilePath, projInfo.Id.ToString()) projectContext.DisplayName <- projInfo.Name projectContext.AddSourceFile(docInfo.FilePath, SourceCodeKind.Regular) @@ -142,7 +142,8 @@ type internal FSharpMetadataAsSourceService() = use writer = new StreamWriter(fileStream) text.Write(writer) - let projectContext = createMetadataProjectContext projInfo document + let projectFile = Path.ChangeExtension(filePath, "fsproj") + let projectContext = createMetadataProjectContext projectFile projInfo document projs.[filePath] <- projectContext diff --git a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs index 4d2159f7c3b..800f05729d3 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs @@ -38,6 +38,7 @@ type internal LexerSymbolKind = | ActivePattern = 5 | String = 6 | Other = 7 + | Keyword = 8 type internal LexerSymbol = { Kind: LexerSymbolKind @@ -149,9 +150,10 @@ module internal Tokenizer = | FSharpGlyph.Error -> Glyph.Error | FSharpGlyph.TypeParameter -> Glyph.TypeParameter - let GetImageIdForSymbol(symbolOpt:FSharpSymbol option, kind:LexerSymbolKind) = + let GetImageIdForSymbol(symbolOpt:FSharpSymbol option, kind:LexerSymbolKind) = let imageId = match kind with + | LexerSymbolKind.Keyword -> KnownImageIds.IntellisenseKeyword | LexerSymbolKind.Operator -> KnownImageIds.Operator | _ -> match symbolOpt with @@ -387,6 +389,7 @@ module internal Tokenizer = elif token.IsIdentifier then LexerSymbolKind.Ident elif token.IsPunctuation then LexerSymbolKind.Punctuation elif token.IsString then LexerSymbolKind.String + elif token.ColorClass = FSharpTokenColorKind.Keyword then LexerSymbolKind.Keyword else LexerSymbolKind.Other Debug.Assert(uint32 token.Tag < 0xFFFFu) Debug.Assert(uint32 kind < 0xFFu) @@ -709,11 +712,12 @@ module internal Tokenizer = // Select IDENT token. If failed, select OPERATOR token. tokensUnderCursor - |> List.tryFind (fun token -> + |> List.tryFind (fun token -> match token.Kind with | LexerSymbolKind.Ident + | LexerSymbolKind.Keyword | LexerSymbolKind.ActivePattern - | LexerSymbolKind.GenericTypeParameter + | LexerSymbolKind.GenericTypeParameter | LexerSymbolKind.StaticallyResolvedTypeParameter -> true | _ -> false) |> Option.orElseWith (fun _ -> tokensUnderCursor |> List.tryFind (fun token -> token.Kind = LexerSymbolKind.Operator)) diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs index 9ac8f778354..4bdfec0bf11 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs @@ -567,8 +567,11 @@ module internal FSharpQuickInfo = let getTargetSymbolQuickInfo (symbol, tag) = asyncMaybe { let targetQuickInfo = - checkFileResults.GetToolTip - (fcsTextLineNumber, idRange.EndColumn, lineText, lexerSymbol.FullIsland,tag) + match lexerSymbol.Kind with + | LexerSymbolKind.Keyword -> checkFileResults.GetKeywordTooltip(lexerSymbol.FullIsland) + | _ -> + checkFileResults.GetToolTip + (fcsTextLineNumber, idRange.EndColumn, lineText, lexerSymbol.FullIsland,tag) match targetQuickInfo with | ToolTipText [] @@ -582,6 +585,7 @@ module internal FSharpQuickInfo = } match lexerSymbol.Kind with + | LexerSymbolKind.Keyword | LexerSymbolKind.String -> let! targetQuickInfo = getTargetSymbolQuickInfo (None, FSharpTokenTag.STRING) return lexerSymbol.Range, None, Some targetQuickInfo diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index 689c410b5f1..b2df69f41eb 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -63,23 +63,23 @@ type LanguageServicePerformanceOptions = { EnableInMemoryCrossProjectReferences: bool AllowStaleCompletionResults: bool TimeUntilStaleCompletion: int - ProjectCheckCacheSize: int } + EnableParallelCheckingWithSignatureFiles: bool + EnableParallelReferenceResolution: bool } static member Default = { EnableInMemoryCrossProjectReferences = true AllowStaleCompletionResults = true TimeUntilStaleCompletion = 2000 // In ms, so this is 2 seconds - ProjectCheckCacheSize = 200 } + EnableParallelCheckingWithSignatureFiles = false + EnableParallelReferenceResolution = false } [] type CodeLensOptions = { Enabled : bool - ReplaceWithLineLens: bool UseColors: bool Prefix : string } static member Default = { Enabled = false UseColors = false - ReplaceWithLineLens = true Prefix = "// " } [] diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs index cc2997f552e..fc90c793bf7 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs @@ -36,24 +36,8 @@ type internal FSharpAsyncQuickInfoSource // test helper static member ProvideQuickInfo(document: Document, position:int) = asyncMaybe { - let! sourceText = document.GetTextAsync() - let textLine = sourceText.Lines.GetLineFromPosition position - let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based - let textLineString = textLine.ToString() - let! symbol = document.TryFindFSharpLexerSymbolAsync(position, SymbolLookupKind.Precise, true, true, nameof(FSharpAsyncQuickInfoSource)) - - let! _, checkFileResults = document.GetFSharpParseAndCheckResultsAsync(nameof(FSharpAsyncQuickInfoSource)) |> liftAsync - let res = checkFileResults.GetToolTip (textLineNumber, symbol.Ident.idRange.EndColumn, textLineString, symbol.FullIsland, FSharpTokenTag.IDENT) - match res with - | ToolTipText [] - | ToolTipText [ToolTipElement.None] -> return! None - | _ -> - let! symbolUse = checkFileResults.GetSymbolUseAtLocation (textLineNumber, symbol.Ident.idRange.EndColumn, textLineString, symbol.FullIsland) - let! symbolSpan = RoslynHelpers.TryFSharpRangeToTextSpan (sourceText, symbol.Range) - return { StructuredText = res - Span = symbolSpan - Symbol = Some symbolUse.Symbol - SymbolKind = symbol.Kind } + let! _, sigQuickInfo, targetQuickInfo = FSharpQuickInfo.getQuickInfo(document, position, CancellationToken.None) + return! sigQuickInfo |> Option.orElse targetQuickInfo } static member BuildSingleQuickInfoItem (documentationBuilder:IDocumentationBuilder) (quickInfo:QuickInfo) = diff --git a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj index 49c902d7704..d247d927341 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj +++ b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj @@ -58,9 +58,7 @@ - - diff --git a/vsintegration/src/FSharp.PatternMatcher/BKTree.Builder.cs b/vsintegration/src/FSharp.PatternMatcher/BKTree.Builder.cs index 42926a67ac5..b05c1bc3453 100644 --- a/vsintegration/src/FSharp.PatternMatcher/BKTree.Builder.cs +++ b/vsintegration/src/FSharp.PatternMatcher/BKTree.Builder.cs @@ -1,5 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +using Microsoft.CodeAnalysis; using Microsoft.CodeAnalysis.Utilities; using System; using System.Collections.Generic; diff --git a/vsintegration/src/FSharp.PatternMatcher/CaseSensitiveComparison.cs b/vsintegration/src/FSharp.PatternMatcher/CaseSensitiveComparison.cs deleted file mode 100644 index cfbfabd718f..00000000000 --- a/vsintegration/src/FSharp.PatternMatcher/CaseSensitiveComparison.cs +++ /dev/null @@ -1,311 +0,0 @@ -using Roslyn.Utilities; -using System; -using System.Diagnostics; -using System.Globalization; -using System.Reflection.Internal; -using System.Text; - -namespace Microsoft.CodeAnalysis.Utilities -{ - internal static class CaseInsensitiveComparison - { - // PERF: Cache a TextInfo for Unicode ToLower since this will be accessed very frequently - private static readonly TextInfo s_unicodeCultureTextInfo = GetUnicodeCulture().TextInfo; - - private static CultureInfo GetUnicodeCulture() - { - try - { - // We use the "en" culture to get the Unicode ToLower mapping, as it implements - // a much more recent Unicode version (6.0+) than the invariant culture (1.0), - // and it matches the Unicode version used for character categorization. - return new CultureInfo("en"); - } - catch (ArgumentException) // System.Globalization.CultureNotFoundException not on all platforms - { - // If "en" is not available, fall back to the invariant culture. Although it has bugs - // specific to the invariant culture (e.g. being version-locked to Unicode 1.0), at least - // we can rely on it being present on all platforms. - return CultureInfo.InvariantCulture; - } - } - - /// - /// ToLower implements the Unicode lowercase mapping - /// as described in ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt. - /// VB uses these mappings for case-insensitive comparison. - /// - /// - /// If is upper case, then this returns its Unicode lower case equivalent. Otherwise, is returned unmodified. - public static char ToLower(char c) - { - // PERF: This is a very hot code path in VB, optimize for ASCII - - // Perform a range check with a single compare by using unsigned arithmetic - if (unchecked((uint)(c - 'A')) <= ('Z' - 'A')) - { - return (char)(c | 0x20); - } - - if (c < 0xC0) // Covers ASCII (U+0000 - U+007F) and up to the next upper-case codepoint (Latin Capital Letter A with Grave) - { - return c; - } - - return ToLowerNonAscii(c); - } - - private static char ToLowerNonAscii(char c) - { - if (c == '\u0130') - { - // Special case Turkish I (LATIN CAPITAL LETTER I WITH DOT ABOVE) - // This corrects for the fact that the invariant culture only supports Unicode 1.0 - // and therefore does not "know about" this character. - return 'i'; - } - - return s_unicodeCultureTextInfo.ToLower(c); - } - - /// - /// This class seeks to perform the lowercase Unicode case mapping. - /// - private sealed class OneToOneUnicodeComparer : StringComparer - { - private static int CompareLowerUnicode(char c1, char c2) - { - return (c1 == c2) ? 0 : ToLower(c1) - ToLower(c2); - } - - public override int Compare(string str1, string str2) - { - if ((object)str1 == str2) - { - return 0; - } - - if ((object)str1 == null) - { - return -1; - } - - if ((object)str2 == null) - { - return 1; - } - - int len = Math.Min(str1.Length, str2.Length); - for (int i = 0; i < len; i++) - { - int ordDiff = CompareLowerUnicode(str1[i], str2[i]); - if (ordDiff != 0) - { - return ordDiff; - } - } - - // return the smaller string, or 0 if they are equal in length - return str1.Length - str2.Length; - } - - private static bool AreEqualLowerUnicode(char c1, char c2) - { - return c1 == c2 || ToLower(c1) == ToLower(c2); - } - - public override bool Equals(string str1, string str2) - { - if ((object)str1 == str2) - { - return true; - } - - if ((object)str1 == null || (object)str2 == null) - { - return false; - } - - if (str1.Length != str2.Length) - { - return false; - } - - for (int i = 0; i < str1.Length; i++) - { - if (!AreEqualLowerUnicode(str1[i], str2[i])) - { - return false; - } - } - - return true; - } - - public static bool EndsWith(string value, string possibleEnd) - { - if ((object)value == possibleEnd) - { - return true; - } - - if ((object)value == null || (object)possibleEnd == null) - { - return false; - } - - int i = value.Length - 1; - int j = possibleEnd.Length - 1; - - if (i < j) - { - return false; - } - - while (j >= 0) - { - if (!AreEqualLowerUnicode(value[i], possibleEnd[j])) - { - return false; - } - - i--; - j--; - } - - return true; - } - - public static bool StartsWith(string value, string possibleStart) - { - if ((object)value == possibleStart) - { - return true; - } - - if ((object)value == null || (object)possibleStart == null) - { - return false; - } - - if (value.Length < possibleStart.Length) - { - return false; - } - - for (int i = 0; i < possibleStart.Length; i++) - { - if (!AreEqualLowerUnicode(value[i], possibleStart[i])) - { - return false; - } - } - - return true; - } - - public override int GetHashCode(string str) - { - int hashCode = Hash.FnvOffsetBias; - - for (int i = 0; i < str.Length; i++) - { - hashCode = Hash.CombineFNVHash(hashCode, ToLower(str[i])); - } - - return hashCode; - } - } - - /// - /// Returns a StringComparer that compares strings according the VB identifier comparison rules. - /// - private static readonly OneToOneUnicodeComparer s_comparer = new OneToOneUnicodeComparer(); - - /// - /// Returns a StringComparer that compares strings according the VB identifier comparison rules. - /// - public static StringComparer Comparer => s_comparer; - - /// - /// Determines if two VB identifiers are equal according to the VB identifier comparison rules. - /// - /// First identifier to compare - /// Second identifier to compare - /// true if the identifiers should be considered the same. - public static bool Equals(string left, string right) => s_comparer.Equals(left, right); - - /// - /// Determines if the string 'value' end with string 'possibleEnd'. - /// - /// - /// - /// - public static bool EndsWith(string value, string possibleEnd) => OneToOneUnicodeComparer.EndsWith(value, possibleEnd); - - /// - /// Determines if the string 'value' starts with string 'possibleStart'. - /// - /// - /// - /// - public static bool StartsWith(string value, string possibleStart) => OneToOneUnicodeComparer.StartsWith(value, possibleStart); - - /// - /// Compares two VB identifiers according to the VB identifier comparison rules. - /// - /// First identifier to compare - /// Second identifier to compare - /// -1 if < , 1 if > , 0 if they are equal. - public static int Compare(string left, string right) => s_comparer.Compare(left, right); - - /// - /// Gets a case-insensitive hash code for VB identifiers. - /// - /// identifier to get the hash code for - /// The hash code for the given identifier - public static int GetHashCode(string value) - { - Debug.Assert(value != null); - - return s_comparer.GetHashCode(value); - } - - /// - /// Convert a string to lower case per Unicode - /// - /// - /// - public static string ToLower(string value) - { - if ((object)value == null) - return null; - - if (value.Length == 0) - return value; - - var pooledStrbuilder = PooledStringBuilder.GetInstance(); - StringBuilder builder = pooledStrbuilder.Builder; - - builder.Append(value); - ToLower(builder); - - return pooledStrbuilder.ToStringAndFree(); - } - - /// - /// In-place convert string in StringBuilder to lower case per Unicode rules - /// - /// - public static void ToLower(StringBuilder builder) - { - if (builder == null) - return; - - for (int i = 0; i < builder.Length; i++) - { - builder[i] = ToLower(builder[i]); - } - } - } -} diff --git a/vsintegration/src/FSharp.PatternMatcher/FSharp.PatternMatcher.csproj b/vsintegration/src/FSharp.PatternMatcher/FSharp.PatternMatcher.csproj index 5005944c7fa..20617fd7527 100644 --- a/vsintegration/src/FSharp.PatternMatcher/FSharp.PatternMatcher.csproj +++ b/vsintegration/src/FSharp.PatternMatcher/FSharp.PatternMatcher.csproj @@ -17,4 +17,8 @@ + + + + \ No newline at end of file diff --git a/vsintegration/src/FSharp.PatternMatcher/VersionStamp.cs b/vsintegration/src/FSharp.PatternMatcher/VersionStamp.cs deleted file mode 100644 index 5f27e306a0d..00000000000 --- a/vsintegration/src/FSharp.PatternMatcher/VersionStamp.cs +++ /dev/null @@ -1,253 +0,0 @@ -using Roslyn.Utilities; -using System; -using System.Diagnostics.Contracts; -using System.Threading; - -namespace Microsoft.CodeAnalysis -{ - /// - /// VersionStamp should be only used to compare versions returned by same API. - /// - internal struct VersionStamp : IEquatable, IObjectWritable - { - public static VersionStamp Default => default(VersionStamp); - - private const int GlobalVersionMarker = -1; - private const int InitialGlobalVersion = 10000; - - /// - /// global counter to avoid collision within same session. - /// it starts with a big initial number just for a clarity in debugging - /// - private static int s_globalVersion = InitialGlobalVersion; - - /// - /// time stamp - /// - private readonly DateTime _utcLastModified; - - /// - /// indicate whether there was a collision on same item - /// - private readonly int _localIncrement; - - /// - /// unique version in same session - /// - private readonly int _globalIncrement; - - private VersionStamp(DateTime utcLastModified) - : this(utcLastModified, 0) - { - } - - private VersionStamp(DateTime utcLastModified, int localIncrement) - { - _utcLastModified = utcLastModified; - _localIncrement = localIncrement; - _globalIncrement = GetNextGlobalVersion(); - } - - private VersionStamp(DateTime utcLastModified, int localIncrement, int globalIncrement) - { - _utcLastModified = utcLastModified; - _localIncrement = localIncrement; - _globalIncrement = globalIncrement; - } - - /// - /// Creates a new instance of a VersionStamp. - /// - public static VersionStamp Create() - { - return new VersionStamp(DateTime.UtcNow); - } - - /// - /// Creates a new instance of a version stamp based on the specified DateTime. - /// - public static VersionStamp Create(DateTime utcTimeLastModified) - { - return new VersionStamp(utcTimeLastModified); - } - - /// - /// compare two different versions and return either one of the versions if there is no collision, otherwise, create a new version - /// that can be used later to compare versions between different items - /// - public VersionStamp GetNewerVersion(VersionStamp version) - { - // * NOTE * - // in current design/implementation, there are 4 possible ways for a version to be created. - // - // 1. created from a file stamp (most likely by starting a new session). "increment" will have 0 as value - // 2. created by modifying existing item (text changes, project changes etc). - // "increment" will have either 0 or previous increment + 1 if there was a collision. - // 3. created from deserialization (probably by using persistent service). - // 4. created by accumulating versions of multiple items. - // - // and this method is the one that is responsible for #4 case. - - if (_utcLastModified > version._utcLastModified) - { - return this; - } - - if (_utcLastModified == version._utcLastModified) - { - var thisGlobalVersion = GetGlobalVersion(this); - var thatGlobalVersion = GetGlobalVersion(version); - - if (thisGlobalVersion == thatGlobalVersion) - { - // given versions are same one - return this; - } - - // mark it as global version - // global version can't be moved to newer version. - return new VersionStamp(_utcLastModified, (thisGlobalVersion > thatGlobalVersion) ? thisGlobalVersion : thatGlobalVersion, GlobalVersionMarker); - } - - return version; - } - - /// - /// Gets a new VersionStamp that is guaranteed to be newer than its base one - /// this should only be used for same item to move it to newer version - /// - public VersionStamp GetNewerVersion() - { - // global version can't be moved to newer version - Contract.Requires(_globalIncrement != GlobalVersionMarker); - - var now = DateTime.UtcNow; - var incr = (now == _utcLastModified) ? _localIncrement + 1 : 0; - - return new VersionStamp(now, incr); - } - - /// - /// Returns the serialized text form of the VersionStamp. - /// - public override string ToString() - { - // 'o' is the roundtrip format that captures the most detail. - return _utcLastModified.ToString("o") + "-" + _globalIncrement + "-" + _localIncrement; - } - - public override int GetHashCode() - { - return Hash.Combine(_utcLastModified.GetHashCode(), _localIncrement); - } - - public override bool Equals(object obj) - { - if (obj is VersionStamp) - { - return this.Equals((VersionStamp)obj); - } - - return false; - } - - public bool Equals(VersionStamp version) - { - if (_utcLastModified == version._utcLastModified) - { - return GetGlobalVersion(this) == GetGlobalVersion(version); - } - - return false; - } - - public static bool operator ==(VersionStamp left, VersionStamp right) - { - return left.Equals(right); - } - - public static bool operator !=(VersionStamp left, VersionStamp right) - { - return !left.Equals(right); - } - - /// - /// check whether given persisted version is re-usable - /// - internal static bool CanReusePersistedVersion(VersionStamp baseVersion, VersionStamp persistedVersion) - { - if (baseVersion == persistedVersion) - { - return true; - } - - // there was a collision, we can't use these - if (baseVersion._localIncrement != 0 || persistedVersion._localIncrement != 0) - { - return false; - } - - return baseVersion._utcLastModified == persistedVersion._utcLastModified; - } - - void IObjectWritable.WriteTo(ObjectWriter writer) - { - WriteTo(writer); - } - - internal void WriteTo(ObjectWriter writer) - { - writer.WriteInt64(_utcLastModified.ToBinary()); - writer.WriteInt32(_localIncrement); - writer.WriteInt32(_globalIncrement); - } - - internal static VersionStamp ReadFrom(ObjectReader reader) - { - var raw = reader.ReadInt64(); - var localIncrement = reader.ReadInt32(); - var globalIncrement = reader.ReadInt32(); - - return new VersionStamp(DateTime.FromBinary(raw), localIncrement, globalIncrement); - } - - private static int GetGlobalVersion(VersionStamp version) - { - // global increment < 0 means it is a global version which has its global increment in local increment - return version._globalIncrement >= 0 ? version._globalIncrement : version._localIncrement; - } - - private static int GetNextGlobalVersion() - { - // REVIEW: not sure what is best way to wrap it when it overflows. should I just throw or don't care. - // with 50ms (typing) as an interval for a new version, it gives more than 1 year before int32 to overflow. - // with 5ms as an interval, it gives more than 120 days before it overflows. - // since global version is only for per VS session, I think we don't need to worry about overflow. - // or we could use Int64 which will give more than a million years turn around even on 1ms interval. - - // this will let versions to be compared safely between multiple items - // without worrying about collision within same session - var globalVersion = Interlocked.Increment(ref VersionStamp.s_globalVersion); - - return globalVersion; - } - - /// - /// True if this VersionStamp is newer than the specified one. - /// - internal bool TestOnly_IsNewerThan(VersionStamp version) - { - if (_utcLastModified > version._utcLastModified) - { - return true; - } - - if (_utcLastModified == version._utcLastModified) - { - return GetGlobalVersion(this) > GetGlobalVersion(version); - } - - return false; - } - } -} \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/CodeLensOptionControl.xaml b/vsintegration/src/FSharp.UIResources/CodeLensOptionControl.xaml index 7e62f575fd6..750cc260b43 100644 --- a/vsintegration/src/FSharp.UIResources/CodeLensOptionControl.xaml +++ b/vsintegration/src/FSharp.UIResources/CodeLensOptionControl.xaml @@ -27,9 +27,6 @@ - diff --git a/vsintegration/src/FSharp.UIResources/FSharp.UIResources.csproj b/vsintegration/src/FSharp.UIResources/FSharp.UIResources.csproj index b11c35d2187..1dfea7e42c8 100644 --- a/vsintegration/src/FSharp.UIResources/FSharp.UIResources.csproj +++ b/vsintegration/src/FSharp.UIResources/FSharp.UIResources.csproj @@ -24,4 +24,19 @@ + + + True + True + Strings.resx + + + + + + PublicResXFileCodeGenerator + Strings.Designer.cs + + + diff --git a/vsintegration/src/FSharp.UIResources/LanguageServicePerformanceOptionControl.xaml b/vsintegration/src/FSharp.UIResources/LanguageServicePerformanceOptionControl.xaml index e67690250dd..26a38d423d5 100644 --- a/vsintegration/src/FSharp.UIResources/LanguageServicePerformanceOptionControl.xaml +++ b/vsintegration/src/FSharp.UIResources/LanguageServicePerformanceOptionControl.xaml @@ -23,27 +23,6 @@ IsChecked="{Binding EnableInMemoryCrossProjectReferences}" Content="{x:Static local:Strings.Enable_in_memory_cross_project_references}" ToolTip="{x:Static local:Strings.Tooltip_in_memory_cross_project_references}"/> - - - - - - @@ -75,6 +54,16 @@ + + + + + + diff --git a/vsintegration/src/FSharp.UIResources/Strings.Designer.cs b/vsintegration/src/FSharp.UIResources/Strings.Designer.cs index fd74fbb404f..2227b3e1819 100644 --- a/vsintegration/src/FSharp.UIResources/Strings.Designer.cs +++ b/vsintegration/src/FSharp.UIResources/Strings.Designer.cs @@ -19,7 +19,7 @@ namespace Microsoft.VisualStudio.FSharp.UIResources { // class via a tool like ResGen or Visual Studio. // To add or remove a member, edit your .ResX file then rerun ResGen // with the /str option, or rebuild your VS project. - [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0")] + [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "17.0.0.0")] [global::System.Diagnostics.DebuggerNonUserCodeAttribute()] [global::System.Runtime.CompilerServices.CompilerGeneratedAttribute()] public class Strings { @@ -177,6 +177,24 @@ public static string Enable_in_memory_cross_project_references { } } + /// + /// Looks up a localized string similar to Enable parallel type checking with signature files. + /// + public static string Enable_Parallel_Checking_With_Signature_Files { + get { + return ResourceManager.GetString("Enable_Parallel_Checking_With_Signature_Files", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Enable parallel reference resolution. + /// + public static string Enable_Parallel_Reference_Resolution { + get { + return ResourceManager.GetString("Enable_Parallel_Reference_Resolution", resourceCulture); + } + } + /// /// Looks up a localized string similar to Enable stale data for IntelliSense features. /// @@ -223,7 +241,7 @@ public static string Enter_Key_Rule { } /// - /// Looks up a localized string similar to Re-format indentation on paste. + /// Looks up a localized string similar to Re-format indentation on paste (Experimental). /// public static string Format_on_paste { get { @@ -268,11 +286,11 @@ public static string Outlining { } /// - /// Looks up a localized string similar to Number of projects whose data is cached in memory. + /// Looks up a localized string similar to Parallelization (requires restart). /// - public static string Project_check_cache_size { + public static string Parallelization { get { - return ResourceManager.GetString("Project_check_cache_size", resourceCulture); + return ResourceManager.GetString("Parallelization", resourceCulture); } } @@ -393,15 +411,6 @@ public static string Tooltip_in_memory_cross_project_references { } } - /// - /// Looks up a localized string similar to Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions.. - /// - public static string Tooltip_project_check_cache_size { - get { - return ResourceManager.GetString("Tooltip_project_check_cache_size", resourceCulture); - } - } - /// /// Looks up a localized string similar to Analyze and suggest fixes for unused values. /// diff --git a/vsintegration/src/FSharp.UIResources/Strings.resx b/vsintegration/src/FSharp.UIResources/Strings.resx index b0ceb57d47a..9846b778ddc 100644 --- a/vsintegration/src/FSharp.UIResources/Strings.resx +++ b/vsintegration/src/FSharp.UIResources/Strings.resx @@ -165,9 +165,6 @@ _Enable in-memory cross project references - - Number of projects whose data is cached in memory - S_how navigation links as @@ -210,9 +207,6 @@ In-memory cross-project references store project-level data in memory to allow IDE features to work across projects. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Always add new line on enter @@ -237,4 +231,13 @@ Diagnostics + + Parallelization (requires restart) + + + Enable parallel type checking with signature files + + + Enable parallel reference resolution + \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf index eb4650c57ed..a2cc11c84f8 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf @@ -47,6 +47,16 @@ Diagnostika + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Výkon @@ -67,6 +77,11 @@ Navigační odkazy + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Zobrazit s_ymboly v neotevřených oborech názvů @@ -87,11 +102,6 @@ _Povolit odkazy mezi projekty v paměti - - Number of projects whose data is cached in memory - Počet projektů, jejichž data jsou uložená v mezipaměti - - S_how navigation links as Zo_brazit navigační odkazy jako @@ -167,11 +177,6 @@ V odkazech v paměti pro různé projekty jsou uložená data na úrovni projektů, aby mohly mezi projekty fungovat funkce IDE. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Projektová data jsou uložená v mezipaměti pro funkce IDE. Vyšší hodnoty znamenají využití více paměti, protože je uloženo více projektů. Vyladění této hodnoty by nemělo mít vliv na malá a středně velká řešení. - - Always add new line on enter Při stisku Enter vždy přidat nový řádek diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf index 7db4ba605f3..3724e517a15 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf @@ -47,6 +47,16 @@ Diagnose + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Leistung @@ -67,6 +77,11 @@ Navigationslinks + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces S_ymbole in nicht geöffneten Namespaces anzeigen @@ -87,11 +102,6 @@ Proj_ektübergreifende Verweise im Arbeitsspeicher aktivieren - - Number of projects whose data is cached in memory - Anzahl von Projekten, deren Daten im Arbeitsspeicher zwischengespeichert werden - - S_how navigation links as Navigationslink_s anzeigen als @@ -167,11 +177,6 @@ Bei projektübergreifenden In-Memory-Verweisen werden Daten auf Projektebene im Arbeitsspeicher abgelegt, damit IDE-Features projektübergreifend verwendet werden können. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Für IDE-Features werden Projektdaten zwischengespeichert. Bei höheren Werten wird mehr Arbeitsspeicher beansprucht, weil mehr Projekte zwischengespeichert werden. Die Optimierung dieses Werts besitzt keine Auswirkungen auf kleine oder mittelgroße Projektmappen. - - Always add new line on enter Nach Drücken der EINGABETASTE immer neue Zeile hinzufügen diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf index 674c69434c2..b8fe4df4030 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf @@ -47,6 +47,16 @@ Diagnóstico + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Rendimiento @@ -67,6 +77,11 @@ Vínculos de navegación + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Mostrar sím_bolos en espacios de nombres sin abrir @@ -87,11 +102,6 @@ _Habilitar referencias entre proyectos en memoria - - Number of projects whose data is cached in memory - Número de proyectos cuyos datos se almacenan en la memoria caché - - S_how navigation links as M_ostrar vínculos de navegación como @@ -167,11 +177,6 @@ Las referencias en memoria entre proyectos almacenan los datos de nivel de proyecto en memoria para permitir que las características del IDE funcionen de unos proyectos a otros. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Los datos de proyecto se almacenan en caché para que funcionen las características del IDE. Los valores más altos utilizan más memoria porque se almacenan en caché más proyectos. El ajuste de este valor no debería afectar a soluciones de tamaño pequeño o medio. - - Always add new line on enter Siempre agregar una nueva línea al pulsar Intro diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf index ec9bafbe8df..82a00f7f4ac 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf @@ -47,6 +47,16 @@ Diagnostics + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Performances @@ -67,6 +77,11 @@ Liens de navigation + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Afficher les sym_boles dans les espaces de noms non ouverts @@ -87,11 +102,6 @@ _Activer les références de projet croisé en mémoire - - Number of projects whose data is cached in memory - Nombre de projets dont les données sont mises en cache dans la mémoire - - S_how navigation links as Affic_her les liens de navigation en tant que @@ -167,11 +177,6 @@ Les références inter-projets en mémoire stockent les données de niveau projet dans la mémoire pour permettre aux fonctionnalités de l'IDE de fonctionner sur plusieurs projets. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Les données de projet sont mises en cache pour les fonctionnalités de l'IDE. Les valeurs plus élevées utilisent plus de mémoire, car davantage de projets sont mis en cache. L'ajustement de cette valeur ne devrait pas affecter les petites ou moyennes solutions. - - Always add new line on enter Toujours ajouter une nouvelle ligne en appuyant sur Entrée diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf index 9b2acf06d1b..3f5a0bef8bb 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf @@ -47,6 +47,16 @@ Diagnostica + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Prestazioni @@ -67,6 +77,11 @@ Collegamenti di navigazione + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Mostra si_mboli in spazi dei nomi non aperti @@ -87,11 +102,6 @@ _Abilita i riferimenti tra progetti in memoria - - Number of projects whose data is cached in memory - Numero di progetti i cui dati sono disponibili nella cache in memoria - - S_how navigation links as M_ostra collegamenti di navigazione come @@ -167,11 +177,6 @@ I riferimenti tra progetti in memoria consentono di archiviare in memoria i dati a livello di progetto per consentire l'uso di funzionalità IDE tra progetti. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - I dati del progetto sono memorizzati nella cache per le funzionalità IDE. Con valori più elevati viene usata una maggiore quantità di memoria perché nella cache viene memorizzato un numero maggiore di progetti. La disattivazione di questo valore non dovrebbe influire su soluzioni di piccole e medie dimensioni. - - Always add new line on enter Aggiungi sempre una nuova riga dopo INVIO diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf index 8ab4c15b6e1..0476d98187d 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf @@ -47,6 +47,16 @@ 診断 + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance パフォーマンス @@ -67,6 +77,11 @@ ナビゲーション リンク + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces 開かれていない名前空間の記号を表示する(_Y) @@ -87,11 +102,6 @@ メモリ内のプロジェクト間参照を有効にする(_E) - - Number of projects whose data is cached in memory - データがメモリ内にキャッシュされているプロジェクトの数 - - S_how navigation links as 次としてナビゲーション リンクを表示する(_H) @@ -167,11 +177,6 @@ メモリ内のプロジェクト間参照に、プロジェクトをまたいで IDE 機能を動作可能にするプロジェクト レベルのデータが格納されます。 - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - IDE 機能のためにプロジェクト データがキャッシュされます。値を高くすると、キャッシュされるプロジェクトが多くなるため、メモリ使用量が増えます。この値の調整は、小規模または中規模のソリューションに影響しません。 - - Always add new line on enter Enter を押すと常に新しい行を追加します diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf index 4812b0acc99..b14183356b6 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf @@ -47,6 +47,16 @@ 진단 + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance 성능 @@ -67,6 +77,11 @@ 탐색 링크 + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces 열려 있지 않은 네임스페이스에 기호 표시(_Y) @@ -87,11 +102,6 @@ 메모리 내 크로스 프로젝트 참조 사용(_E) - - Number of projects whose data is cached in memory - 메모리에 데이터가 캐시된 프로젝트 수 - - S_how navigation links as 탐색 링크를 다음으로 표시(_H) @@ -167,11 +177,6 @@ 메모리 내 크로스 프로젝트 참조가 메모리에 프로젝트 수준 데이터를 저장하여 IDE 기능이 프로젝트에서 작동하도록 합니다. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - 프로젝트 데이터가 IDE 기능에 대해 캐시됩니다. 값이 클수록 프로제트가 더 많이 캐시되므로 메모리를 더 많이 사용합니다. 이 값을 조정해도 중소 규모 솔루션에 영향을 미치지 않습니다. - - Always add new line on enter 입력 시 새 줄 항상 추가 diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf index c96168985ec..02fd84cb017 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf @@ -47,6 +47,16 @@ Diagnostyka + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Wydajność @@ -67,6 +77,11 @@ Linki nawigacyjne + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Pokaż s_ymbole w nieotwartych przestrzeniach nazw @@ -87,11 +102,6 @@ _Włącz odwołania między projektami w pamięci - - Number of projects whose data is cached in memory - Liczba projektów, które mają dane buforowane w pamięci - - S_how navigation links as P_okaż linki nawigacyjne jako @@ -167,11 +177,6 @@ Odwołania między projektami w pamięci przechowują dane na poziomie projektu w pamięci, aby umożliwić funkcjom środowiska IDE działanie w wielu projektach. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Dane projektów są buforowane na potrzeby funkcji środowiska IDE. Wyższe wartości powodują używanie większej ilości pamięci, ponieważ buforowanych jest więcej projektów. Dostrajanie tej wartości nie powinno mieć wpływu na małe ani średnie rozwiązania. - - Always add new line on enter Zawsze dodawaj nowy wiersz po naciśnięciu klawisza Enter diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf index 076de7f9087..7ca5a251c15 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf @@ -47,6 +47,16 @@ Diagnóstico + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Desempenho @@ -67,6 +77,11 @@ Links de navegação + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Mostrar s_ímbolos em namespaces não abertos @@ -87,11 +102,6 @@ _Habilitar referências de projeto cruzado na memória - - Number of projects whose data is cached in memory - Número de projetos cujos dados estão em cache na memória - - S_how navigation links as E_xibir link de navegação como @@ -167,11 +177,6 @@ As referências entre projetos na memória armazenam os dados de nível de projeto na memória para permitir que os recursos do IDE funcionem nos projetos. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Os dados do projeto são colocados em cache para os recursos do IDE. Os valores mais altos utilizam mais memória porque mais projetos são colocados em cache. O ajuste desses valores não deve afetar as soluções de pequeno ou médio porte. - - Always add new line on enter Sempre adicionar uma nova linha ao pressionar enter diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf index 690059925df..91c8065c0ca 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf @@ -47,6 +47,16 @@ Диагностика + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Производительность @@ -67,6 +77,11 @@ Ссылки навигации + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces По_казать символы в неоткрытых пространствах имен @@ -87,11 +102,6 @@ _Включить перекрестные ссылки между проектами в памяти - - Number of projects whose data is cached in memory - Число проектов, данные которых кэшируются в памяти - - S_how navigation links as П_оказать ссылки навигации как @@ -167,11 +177,6 @@ Перекрестные ссылки между проектами в памяти хранят данные уровня проекта в памяти, поэтому функции и компоненты IDE могут работать в разных проектах. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - Для функций и компонентов IDE используются кэшированные данные проекта. Более высокие значения потребляют больший объем памяти, так как кэшируется больше проектов. Настройка этого значения не должна влиять на решения небольших или средних размеров. - - Always add new line on enter Всегда добавлять новую строку при нажатии клавиши ВВОД diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf index e05c403767a..f7de45984dc 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf @@ -47,6 +47,16 @@ Tanılama + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance Performans @@ -67,6 +77,11 @@ Gezinti bağlantıları + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces Açılmamış ad alanlarında s_embolleri göster @@ -87,11 +102,6 @@ _Bellek içi çapraz proje başvurularını etkinleştir - - Number of projects whose data is cached in memory - Verileri bellekte önbelleğe alınan proje sayısı - - S_how navigation links as Gezinti bağlantılarını farklı _göster @@ -167,11 +177,6 @@ Bellek içi projeler arası başvurular, IDE özelliklerinin farklı projelerde çalışmasına imkan tanımak için bellekte proje düzeyi veriler depolar. - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - IDE özellikleri için proje verileri önbelleğe alınır. Değer yüksek olduğunda daha fazla proje önbelleğe alındığından daha fazla bellek kullanılır. Bu değerin ayarlanması küçük veya orta ölçekli çözümleri etkilememelidir. - - Always add new line on enter Enter'a basıldığında her zaman yeni satır ekle diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf index b219edc12c0..7478bb60d18 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf @@ -47,6 +47,16 @@ 诊断 + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance 性能 @@ -67,6 +77,11 @@ 导航链接 + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces 显示未打开的命名空间中的符号(_Y) @@ -87,11 +102,6 @@ 启用内存中跨项目引用(_E) - - Number of projects whose data is cached in memory - 内存中缓存了其数据的项目数 - - S_how navigation links as 导航链接显示方式(_H) @@ -167,11 +177,6 @@ 内存中跨项目引用将项目级数据存储在内存中，让 IDE 功能能够跨项目工作。 - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - 针对 IDE 功能缓存项目数据。值越大，缓存的项目越多，因此使用的内存越多。调整此值不应影响小型或中型解决方案。 - - Always add new line on enter 始终在点击回车时时添加新行 diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf index 0b6b964edda..255c7ee09d5 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf @@ -47,6 +47,16 @@ 診斷 + + Enable parallel type checking with signature files + Enable parallel type checking with signature files + + + + Enable parallel reference resolution + Enable parallel reference resolution + + Performance 效能 @@ -67,6 +77,11 @@ 導覽連結 + + Parallelization (requires restart) + Parallelization (requires restart) + + Show s_ymbols in unopened namespaces 顯示未開啟之命名空間中的符號(_Y) @@ -87,11 +102,6 @@ 允許記憶體內跨專案參考(_E) - - Number of projects whose data is cached in memory - 資料會快取到記憶體的專案數 - - S_how navigation links as 顯示導覽連結為(_H) @@ -167,11 +177,6 @@ 記憶體內跨專案參考，會在記憶體中儲存專案等級的資料，以允許 IDE 功能在各專案中皆可運作。 - - Project data is cached for IDE features. Higher values use more memory because more projects are cached. Tuning this value should not affect small or medium-sized solutions. - 專案資料會進行快取，供 IDE 功能使用。值較高時會使用較多的記憶體，這是因為會快取較多的專案數。調整此值應該不會影響中小型的解決方案。 - - Always add new line on enter 一律在按 ENTER 時新增新行 diff --git a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj index 513e0e7207d..b7819fb3611 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj @@ -57,6 +57,8 @@ + + @@ -64,7 +66,8 @@ - + + diff --git a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj index 4b7ef972b0d..58862ce6747 100644 --- a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj +++ b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj @@ -48,7 +48,6 @@ - diff --git a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs index 0a889d6d19b..9575d2b1e06 100644 --- a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs @@ -43,7 +43,7 @@ let internal projectOptions = { let private normalizeLineEnds (s: string) = s.Replace("\r\n", "\n").Replace("\n\n", "\n") -let private getQuickInfoText (ToolTipText elements) : string = +let private tooltipTextToRawString (ToolTipText elements) : string = let rec parseElement = function | ToolTipElement.None -> "" | ToolTipElement.Group(xs) -> @@ -63,36 +63,114 @@ let private getQuickInfoText (ToolTipText elements) : string = | ToolTipElement.CompositionError(error) -> error elements |> List.map parseElement |> String.concat "\n" |> normalizeLineEnds +let executeQuickInfoTest (programText:string) testCases = + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, programText) + Assert.Multiple(fun _ -> + for (symbol: string, expected: string option) in testCases do + let expected = expected |> Option.map normalizeLineEnds |> Option.map (fun s -> s.Replace("___","")) + let caretPosition = programText.IndexOf(symbol) + symbol.Length - 1 + + let quickInfo = + FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) + |> Async.RunSynchronously + + let actual = quickInfo |> Option.map (fun qi -> tooltipTextToRawString qi.StructuredText) + Assert.AreEqual(expected, actual,"Symbol: " + symbol) + ) + [] let ShouldShowQuickInfoAtCorrectPositions() = + let fileContents = """ +let x = 1 +let y = 2 +System.Console.WriteLine(x + y) + """ + let testCases = - [ "x", Some "val x: int\nFull name: Test.x" + [ "let", Some "let___Used to associate, or bind, a name to a value or function." + "x", Some "val x: int\nFull name: Test.x" "y", Some "val y: int\nFull name: Test.y" "1", None "2", None - "x +", Some "val x: int\nFull name: Test.x" + "x +", Some """val (+) : x: 'T1 -> y: 'T2 -> 'T3 (requires member (+)) +Full name: Microsoft.FSharp.Core.Operators.(+) +'T1 is int +'T2 is int +'T3 is int""" "System", Some "namespace System" - "WriteLine", Some "System.Console.WriteLine(value: int) : unit" ] - - for (symbol: string, expected: string option) in testCases do - let expected = expected |> Option.map normalizeLineEnds - let fileContents = """ - let x = 1 - let y = 2 - System.Console.WriteLine(x + y) + "WriteLine", Some "System.Console.WriteLine(value: int) : unit" + ] + + executeQuickInfoTest fileContents testCases + + +[] +let ShouldShowQuickKeywordInfoAtCorrectPositionsForSignatureFiles() = + let fileContents = """ +namespace TestNs +module internal MyModule = + val MyVal: isDecl:bool -> string + """ + let testCases = + [ "namespace", Some "namespace___Used to associate a name with a group of related types and modules, to logically separate it from other code." + "module", Some "module___Used to associate a name with a group of related types, values, and functions, to logically separate it from other code." + "internal", Some "internal___Used to specify that a member is visible inside an assembly but not outside it." + "val", Some "val___Used in a signature to indicate a value, or in a type to declare a member, in limited situations." + "->", Some "->___In function types, delimits arguments and return values. Yields an expression (in sequence expressions); equivalent to the yield keyword. Used in match expressions" + ] + executeQuickInfoTest fileContents testCases + +[] +let ShouldShowQuickKeywordInfoAtCorrectPositionsWithinComputationExpressions() = + let fileContents = """ +type MyOptionBuilder() = + member __.Zero() = None + member __.Return(x: 'T) = Some x + member __.Bind(m: 'T option, f) = Option.bind f m + +let myOpt = MyOptionBuilder() +let x = + myOpt{ + let! x = Some 5 + let! y = Some 11 + return x + y + } """ - let caretPosition = fileContents.IndexOf(symbol) - let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) - let quickInfo = - FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) - |> Async.RunSynchronously - - let actual = quickInfo |> Option.map (fun qi -> getQuickInfoText qi.StructuredText) - Assert.AreEqual(expected, actual) + let testCases = + [ "let!", Some "let!___Used in computation expressions to bind a name to the result of another computation expression." + "return", Some "return___Used to provide a value for the result of the containing computation expression." + ] + + executeQuickInfoTest fileContents testCases [] let ShouldShowQuickInfoForGenericParameters() = + let fileContents = """ + +type C() = + member x.FSharpGenericMethodExplitTypeParams<'T>(a:'T, y:'T) = (a,y) + + member x.FSharpGenericMethodInferredTypeParams(a, y) = (a,y) + +open System.Linq +let coll = [ for i in 1 .. 100 -> (i, string i) ] +let res1 = coll.GroupBy (fun (a, b) -> a) +let res2 = System.Array.Sort [| 1 |] +let test4 x = C().FSharpGenericMethodExplitTypeParams([x], [x]) +let test5<'U> (x: 'U) = C().FSharpGenericMethodExplitTypeParams([x], [x]) +let test6 = C().FSharpGenericMethodExplitTypeParams(1, 1) +let test7 x = C().FSharpGenericMethodInferredTypeParams([x], [x]) +let test8 = C().FSharpGenericMethodInferredTypeParams(1, 1) +let test9<'U> (x: 'U) = C().FSharpGenericMethodInferredTypeParams([x], [x]) +let res3 = [1] |> List.map id +let res4 = (1.0,[1]) ||> List.fold (fun s x -> string s + string x) // note there is a type error here, still cehck quickinfo any way +let res5 = 1 + 2 +let res6 = System.DateTime.Now + System.TimeSpan.Zero +let res7 = sin 5.0 +let res8 = abs 5.0 + """ + let testCases = [("GroupBy", @@ -184,44 +262,5 @@ Full name: Microsoft.FSharp.Core.Operators.sin "val abs: value: 'T -> 'T (requires member Abs) Full name: Microsoft.FSharp.Core.Operators.abs 'T is int")] - let actualForAllTests = - [ for (symbol: string, expected: string option) in testCases do - let expected = expected |> Option.map normalizeLineEnds - let fileContents = """ - -type C() = - member x.FSharpGenericMethodExplitTypeParams<'T>(a:'T, y:'T) = (a,y) - - member x.FSharpGenericMethodInferredTypeParams(a, y) = (a,y) - -open System.Linq -let coll = [ for i in 1 .. 100 -> (i, string i) ] -let res1 = coll.GroupBy (fun (a, b) -> a) -let res2 = System.Array.Sort [| 1 |] -let test4 x = C().FSharpGenericMethodExplitTypeParams([x], [x]) -let test5<'U> (x: 'U) = C().FSharpGenericMethodExplitTypeParams([x], [x]) -let test6 = C().FSharpGenericMethodExplitTypeParams(1, 1) -let test7 x = C().FSharpGenericMethodInferredTypeParams([x], [x]) -let test8 = C().FSharpGenericMethodInferredTypeParams(1, 1) -let test9<'U> (x: 'U) = C().FSharpGenericMethodInferredTypeParams([x], [x]) -let res3 = [1] |> List.map id -let res4 = (1.0,[1]) ||> List.fold (fun s x -> string s + string x) // note there is a type error here, still cehck quickinfo any way -let res5 = 1 + 2 -let res6 = System.DateTime.Now + System.TimeSpan.Zero -let res7 = sin 5.0 -let res8 = abs 5.0 - """ - let caretPosition = fileContents.IndexOf(symbol) + symbol.Length - 1 - let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) - - let quickInfo = - FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) - |> Async.RunSynchronously - - let actual = quickInfo |> Option.map (fun qi -> getQuickInfoText qi.StructuredText) - yield symbol, actual ] - for ((_, expected),(_,actual)) in List.zip testCases actualForAllTests do - let normalizedExpected = Option.map normalizeLineEnds expected - let normalizedActual = Option.map normalizeLineEnds actual - Assert.AreEqual(normalizedExpected, normalizedActual) + executeQuickInfoTest fileContents testCases \ No newline at end of file diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index 54122e4ff71..35ccf0f4d03 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -19,7 +19,7 @@ type Check = try try #if DEBUG - FSharp.Compiler.CompilerDiagnostics.CompilerService.showAssertForUnexpectedException := false + FSharp.Compiler.CompilerDiagnostics.showAssertForUnexpectedException := false #endif if (FileSystem.FileExistsShim("watson-test.fs")) then FileSystem.FileDeleteShim("watson-test.fs") @@ -46,7 +46,7 @@ type Check = Assert.Fail("An InternalError exception occurred.") finally #if DEBUG - FSharp.Compiler.CompilerDiagnostics.CompilerService.showAssertForUnexpectedException := true + FSharp.Compiler.CompilerDiagnostics.showAssertForUnexpectedException := true #endif FileSystem.FileDeleteShim("watson-test.fs") diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index abcae6d9074..542ec626ebd 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -165,9 +165,7 @@ - -