diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 41ac0500f5..76b0d57318 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -6,9 +6,17 @@ jobs: build: strategy: + fail-fast: false matrix: os: [windows-latest, macos-latest, ubuntu-latest] - dotnet: [3.1.201] # TODO: wish this action didn't pin versions... + dotnet: [3.1.301] # TODO: wish this action didn't pin versions... + include: + - os: windows-latest + knownFailure: false + - os: macos-latest + knownFailure: true + - os: ubuntu-latest + knownFailure: true runs-on: ${{ matrix.os }} steps: @@ -20,11 +28,16 @@ jobs: - name: Restore tools run: dotnet tool restore working-directory: ./fcs - - name: Build and test - run: dotnet fake build -t TestAndNuGet + - name: Build + run: dotnet fake build -t Build working-directory: ./fcs + - name: Test + run: dotnet fake build -s -t Test + working-directory: ./fcs + if: ${{ !matrix.knownFailure }} - name: Archive code coverage results uses: actions/upload-artifact@v2 + if: always() with: - name: code-coverage-report + name: code-coverage-report-${{ matrix.os }}-${{ env.GITHUB_SHA }} path: ${{ github.workspace }}/artifacts/TestResults/Release/FSharp.Compiler.Service.Test.*.xml \ No newline at end of file diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index c5aa46e18b..d321ff2960 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -15,7 +15,7 @@ jobs: - name: Setup .NET Core uses: actions/setup-dotnet@v1 with: - dotnet-version: 3.1.201 + dotnet-version: 3.1.301 - name: Restore tools run: dotnet tool restore working-directory: ./fcs diff --git a/.github/workflows/publish.yml b/.github/workflows/publish.yml index 0d3da48e0e..3678c0a5ae 100644 --- a/.github/workflows/publish.yml +++ b/.github/workflows/publish.yml @@ -11,7 +11,7 @@ jobs: strategy: matrix: os: [macos-latest] - dotnet: [3.1.201] + dotnet: [3.1.301] runs-on: ${{ matrix.os }} steps: @@ -23,21 +23,21 @@ jobs: - name: Restore tools run: dotnet tool restore working-directory: ./fcs - - name: Build and Test - run: dotnet fake build -t TestAndNuget + - name: Build and package + run: dotnet fake build -t NuGet working-directory: ./fcs - name: Validate package bump run: dotnet fake build -s -t ValidateVersionBump working-directory: ./fcs - - name: Publish to nuget - run: dotnet fake build -s -t PublishNuget - working-directory: ./fcs - env: - NUGET_APIKEY: ${{ secrets.NUGET_APIKEY }} - name: Create release run: dotnet fake build -s -t CreateRelease working-directory: ./fcs env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + - name: Publish to nuget + run: dotnet fake build -s -t PublishNuget + working-directory: ./fcs + env: + NUGET_APIKEY: ${{ secrets.NUGET_APIKEY }} \ No newline at end of file diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 791850399b..681a3d3c70 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -10,6 +10,7 @@ $(RepoRoot)src + $(RepoRoot)tests $(ArtifactsDir)\SymStore $(ArtifactsDir)\Bootstrap 4.4.0 diff --git a/FSharpTests.Directory.Build.props b/FSharpTests.Directory.Build.props index 8a4730f8dd..90d7376140 100644 --- a/FSharpTests.Directory.Build.props +++ b/FSharpTests.Directory.Build.props @@ -22,18 +22,18 @@ $([System.IO.Path]::GetDirectoryName('$(DOTNET_HOST_PATH)')) dotnet.exe dotnet - $(MSBuildThisFileDirectory)artifacts\bin\fsc\$(Configuration)\netcoreapp3.0\fsc.exe + $(MSBuildThisFileDirectory)artifacts\bin\fsc\$(Configuration)\netcoreapp3.1\fsc.exe $([System.IO.Path]::GetDirectoryName('$(DOTNET_HOST_PATH)')) dotnet.exe dotnet - $(MSBuildThisFileDirectory)artifacts\bin\fsi\$(Configuration)\netcoreapp3.0\fsi.exe + $(MSBuildThisFileDirectory)artifacts\bin\fsi\$(Configuration)\netcoreapp3.1\fsi.exe <_FSharpBuildTargetFramework Condition="'$(MSBuildRuntimeType)'!='Core'">net472 - <_FSharpBuildTargetFramework Condition="'$(MSBuildRuntimeType)'=='Core'">netcoreapp3.0 + <_FSharpBuildTargetFramework Condition="'$(MSBuildRuntimeType)'=='Core'">netcoreapp3.1 <_FSharpBuildBinPath>$(MSBuildThisFileDirectory)artifacts\bin\fsc\$(Configuration)\$(_FSharpBuildTargetFramework) $(_FSharpBuildBinPath)\FSharp.Build.dll diff --git a/clean.sh b/clean.sh index 7f4d4c423b..6b110b2d01 100755 --- a/clean.sh +++ b/clean.sh @@ -19,6 +19,7 @@ DEAD_DIRS=( "TESTGUIDE.md" "tests/EndToEndBuildTests" "tests/FSharp.Build.UnitTests" + "tests/FSharp.Compiler.ComponentTests" "tests/FSharp.Compiler.Private.Scripting.UnitTests" "tests/FSharp.Compiler.UnitTests" "tests/FSharp.Core.UnitTests" diff --git a/eng/Build.ps1 b/eng/Build.ps1 index efc0c86529..add0d3f7da 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -152,11 +152,11 @@ function Process-Arguments() { function Update-Arguments() { if ($script:noVisualStudio) { - $script:bootstrapTfm = "netcoreapp3.0" + $script:bootstrapTfm = "netcoreapp3.1" $script:msbuildEngine = "dotnet" } - if ($bootstrapTfm -eq "netcoreapp3.0") { + if ($bootstrapTfm -eq "netcoreapp3.1") { if (-Not (Test-Path "$ArtifactsDir\Bootstrap\fsc\fsc.runtimeconfig.json")) { $script:bootstrap = $True } @@ -178,7 +178,7 @@ function BuildSolution() { $officialBuildId = if ($official) { $env:BUILD_BUILDNUMBER } else { "" } $toolsetBuildProj = InitializeToolset $quietRestore = !$ci - $testTargetFrameworks = if ($testCoreClr) { "netcoreapp3.0" } else { "" } + $testTargetFrameworks = if ($testCoreClr) { "netcoreapp3.1" } else { "" } # Do not set the property to true explicitly, since that would override value projects might set. $suppressExtensionDeployment = if (!$deployExtensions) { "/p:DeployExtension=false" } else { "" } @@ -264,7 +264,7 @@ function TestUsingNUnit([string] $testProject, [string] $targetFramework) { } function BuildCompiler() { - if ($bootstrapTfm -eq "netcoreapp3.0") { + if ($bootstrapTfm -eq "netcoreapp3.1") { $dotnetPath = InitializeDotNetCli $dotnetExe = Join-Path $dotnetPath "dotnet.exe" $fscProject = "$RepoRoot\src\fsharp\fsc\fsc.fsproj" @@ -277,14 +277,14 @@ function BuildCompiler() { $logFilePath = Join-Path $LogDir "fscBootstrapLog.binlog" $args += " /bl:$logFilePath" } - $args = "build $fscProject -c $configuration -v $verbosity -f netcoreapp3.0" + $argNoRestore + $argNoIncremental + $args = "build $fscProject -c $configuration -v $verbosity -f netcoreapp3.1" + $argNoRestore + $argNoIncremental Exec-Console $dotnetExe $args if ($binaryLog) { $logFilePath = Join-Path $LogDir "fsiBootstrapLog.binlog" $args += " /bl:$logFilePath" } - $args = "build $fsiProject -c $configuration -v $verbosity -f netcoreapp3.0" + $argNoRestore + $argNoIncremental + $args = "build $fsiProject -c $configuration -v $verbosity -f netcoreapp3.1" + $argNoRestore + $argNoIncremental Exec-Console $dotnetExe $args } } @@ -448,9 +448,10 @@ try { $script:BuildCategory = "Test" $script:BuildMessage = "Failure running tests" $desktopTargetFramework = "net472" - $coreclrTargetFramework = "netcoreapp3.0" + $coreclrTargetFramework = "netcoreapp3.1" if ($testDesktop -and -not $noVisualStudio) { + TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $desktopTargetFramework @@ -459,6 +460,7 @@ try { } if ($testCoreClr) { + TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $coreclrTargetFramework diff --git a/eng/Versions.props b/eng/Versions.props index 9bc5e185e3..a9b401f28b 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -176,7 +176,7 @@ 2.7.0 3.0.0-preview-27318-01 3.0.0-preview-27318-01 - 15.8.0 + 16.6.1 4.3.0 9.0.1 3.11.0 @@ -186,5 +186,7 @@ 1.0.0-beta2-dev3 5.28.0.1 2.0.187 + 2.4.1 + 5.10.3 diff --git a/eng/build-utils.ps1 b/eng/build-utils.ps1 index 7f06d7ac4c..dd812ea797 100644 --- a/eng/build-utils.ps1 +++ b/eng/build-utils.ps1 @@ -244,16 +244,16 @@ function Make-BootstrapBuild() { $argNoRestore = if ($norestore) { " --no-restore" } else { "" } $argNoIncremental = if ($rebuild) { " --no-incremental" } else { "" } - $args = "build $buildToolsProject -c $bootstrapConfiguration -v $verbosity -f netcoreapp3.0" + $argNoRestore + $argNoIncremental + $args = "build $buildToolsProject -c $bootstrapConfiguration -v $verbosity -f netcoreapp3.1" + $argNoRestore + $argNoIncremental if ($binaryLog) { $logFilePath = Join-Path $LogDir "toolsBootstrapLog.binlog" $args += " /bl:$logFilePath" } Exec-Console $dotnetExe $args - Copy-Item "$ArtifactsDir\bin\fslex\$bootstrapConfiguration\netcoreapp3.0" -Destination "$dir\fslex" -Force -Recurse - Copy-Item "$ArtifactsDir\bin\fsyacc\$bootstrapConfiguration\netcoreapp3.0" -Destination "$dir\fsyacc" -Force -Recurse - Copy-Item "$ArtifactsDir\bin\AssemblyCheck\$bootstrapConfiguration\netcoreapp3.0" -Destination "$dir\AssemblyCheck" -Force -Recurse + Copy-Item "$ArtifactsDir\bin\fslex\$bootstrapConfiguration\netcoreapp3.1" -Destination "$dir\fslex" -Force -Recurse + Copy-Item "$ArtifactsDir\bin\fsyacc\$bootstrapConfiguration\netcoreapp3.1" -Destination "$dir\fsyacc" -Force -Recurse + Copy-Item "$ArtifactsDir\bin\AssemblyCheck\$bootstrapConfiguration\netcoreapp3.1" -Destination "$dir\AssemblyCheck" -Force -Recurse # prepare compiler $protoProject = "$RepoRoot\proto.proj" diff --git a/eng/build.sh b/eng/build.sh index a862cb9f38..f5e119cb34 100755 --- a/eng/build.sh +++ b/eng/build.sh @@ -244,8 +244,8 @@ function BuildSolution { /t:Publish mkdir -p "$bootstrap_dir" - cp -pr $artifacts_dir/bin/fslex/$bootstrap_config/netcoreapp3.0/publish $bootstrap_dir/fslex - cp -pr $artifacts_dir/bin/fsyacc/$bootstrap_config/netcoreapp3.0/publish $bootstrap_dir/fsyacc + cp -pr $artifacts_dir/bin/fslex/$bootstrap_config/netcoreapp3.1/publish $bootstrap_dir/fslex + cp -pr $artifacts_dir/bin/fsyacc/$bootstrap_config/netcoreapp3.1/publish $bootstrap_dir/fsyacc fi if [ ! -f "$bootstrap_dir/fsc.exe" ]; then BuildMessage="Error building bootstrap" @@ -254,7 +254,7 @@ function BuildSolution { /p:Configuration=$bootstrap_config \ /t:Publish - cp -pr $artifacts_dir/bin/fsc/$bootstrap_config/netcoreapp3.0/publish $bootstrap_dir/fsc + cp -pr $artifacts_dir/bin/fsc/$bootstrap_config/netcoreapp3.1/publish $bootstrap_dir/fsc fi # do real build @@ -293,7 +293,7 @@ InitializeDotNetCli $restore BuildSolution if [[ "$test_core_clr" == true ]]; then - coreclrtestframework=netcoreapp3.0 + coreclrtestframework=netcoreapp3.1 TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj" --targetframework $coreclrtestframework diff --git a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 8348074be3..7f3b33ad92 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -2,7 +2,7 @@ - $(FcsTargetNetFxFramework);netcoreapp3.0 + $(FcsTargetNetFxFramework);netcoreapp3.1 true 4.1.19 $(NoWarn);44;75; @@ -73,7 +73,7 @@ ScriptOptionsTests.fs - + Program.fs diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 4ccdbdc28f..52bc14faf8 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -5,6 +5,7 @@ + $(FcsTargetNetFxFramework);netstandard2.0 true @@ -33,6 +34,8 @@ https://github.com/fsharp/FSharp.Compiler.Service logo.png F#, fsharp, interactive, compiler, editor + true + true $(DefineConstants);FX_NO_PDB_READER @@ -726,6 +729,7 @@ + diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index 59921973af..2bdff4b24b 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,18 @@ +#### 36.0.2 + +This is a small bugfix release that I'm making primarily to publish a version +of FCS with sourcelink enabled, so that tooling users can make use of that information. + +From dotnet/fsharp:079276b4b..37d0cccec: + +* Fixes for `do!` handling in computation expressions (thanks @baronfel) +* Add missing versions in FCS' Interactive header (thanks @nightroman) +* Support `Source`-translation in `match!` expressions (thanks @baronfel) +* Ensure stack traces from uncaught exceptions in CEs are maintained (thanks @NinoFloris) +* Better handling of `inline` in witness-passing codepaths (thanks @dsyme) +* Enable publishing of FCS with sourcelink (thanks @baronfel) +* Extend `nameof` to support naming generic parameters (`nameof<'t>`) and instance members (`nameof(Unchecked.defaultof.Property)`) (thanks @dsyme) + #### 36.0.1 From dotnet/fsharp:522dd906c..16bca5aef: diff --git a/fcs/build.fsx b/fcs/build.fsx index b6426c8e30..96188bcfe8 100644 --- a/fcs/build.fsx +++ b/fcs/build.fsx @@ -59,8 +59,8 @@ Target.create "Restore" (fun _ -> Target.create "Build" (fun _ -> runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto" - let fslexPath = Path.GetFullPath <| Path.Combine(__SOURCE_DIRECTORY__, "../artifacts/bin/fslex/Proto/netcoreapp3.1/fslex.dll") - let fsyaccPath = Path.GetFullPath <| Path.Combine(__SOURCE_DIRECTORY__, "../artifacts/bin/fsyacc/Proto/netcoreapp3.1/fsyacc.dll") + let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp3.1/fslex.dll" + let fsyaccPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fsyacc/Proto/netcoreapp3.1/fsyacc.dll" runDotnet __SOURCE_DIRECTORY__ "build" (sprintf "FSharp.Compiler.Service.sln -nodereuse:false -v n -c Release /p:DisableCompilerRedirection=true /p:FsLexPath=%s /p:FsYaccPath=%s" fslexPath fsyaccPath) ) diff --git a/fcs/global.json b/fcs/global.json index e63e25046a..656748d259 100644 --- a/fcs/global.json +++ b/fcs/global.json @@ -1,6 +1,6 @@ { "sdk": { - "version": "3.1.200", + "version": "3.1.301", "rollForward":"minor" } } \ No newline at end of file diff --git a/fcs/paket.dependencies b/fcs/paket.dependencies index 58b91aa427..4e7c7c393d 100644 --- a/fcs/paket.dependencies +++ b/fcs/paket.dependencies @@ -36,4 +36,4 @@ source https://api.nuget.org/v3/index.json framework: netstandard2.0 storage: packages -nuget FSharp.Compiler.Service 35.0.0 \ No newline at end of file +nuget FSharp.Compiler.Service 36.0.1 \ No newline at end of file diff --git a/fcs/paket.lock b/fcs/paket.lock index dd09629c5a..ab43c1bb6c 100644 --- a/fcs/paket.lock +++ b/fcs/paket.lock @@ -716,7 +716,7 @@ STORAGE: PACKAGES RESTRICTION: == netstandard2.0 NUGET remote: https://api.nuget.org/v3/index.json - FSharp.Compiler.Service (35.0) + FSharp.Compiler.Service (36.0.1) FSharp.Core (>= 4.6.2) System.Buffers (>= 4.5) System.Collections.Immutable (>= 1.5) diff --git a/fcs/samples/EditorService/EditorService.fsproj b/fcs/samples/EditorService/EditorService.fsproj index f3e3f7e10f..b5618a634c 100644 --- a/fcs/samples/EditorService/EditorService.fsproj +++ b/fcs/samples/EditorService/EditorService.fsproj @@ -1,7 +1,7 @@  - $(FcsTargetNetFxFramework);netcoreapp3.0 + $(FcsTargetNetFxFramework);netcoreapp3.1 true Exe false diff --git a/global.json b/global.json index 72a67e855f..146979f9b9 100644 --- a/global.json +++ b/global.json @@ -1,6 +1,6 @@ { "tools": { - "dotnet": "3.1.200", + "dotnet": "3.1.301", "vs": { "version": "16.4", "components": [ diff --git a/proto.proj b/proto.proj index 3a9793b4be..f24b2580e3 100644 --- a/proto.proj +++ b/proto.proj @@ -7,13 +7,13 @@ - TargetFramework=netcoreapp3.0 + TargetFramework=netcoreapp3.1 - TargetFramework=netcoreapp3.0 + TargetFramework=netcoreapp3.1 - TargetFramework=netcoreapp3.0 + TargetFramework=netcoreapp3.1 diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 59c10dbbaa..63aabe9d01 100755 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -385,6 +385,11 @@ module List = mn 0 xs let count pred xs = List.fold (fun n x -> if pred x then n+1 else n) 0 xs + let headAndTail l = + match l with + | [] -> failwith "headAndTail" + | h::t -> (h,t) + // WARNING: not tail-recursive let mapHeadTail fhead ftail = function | [] -> [] diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 6405c135d3..f9d568d4a0 100755 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -1481,14 +1481,13 @@ let emitParameter cenv emEnv (defineParameter: int * ParameterAttributes * strin // buildMethodPass2 //---------------------------------------------------------------------------- -#if !FX_RESHAPED_REFEMIT || NETCOREAPP3_0 +#if !FX_RESHAPED_REFEMIT || NETCOREAPP3_1 let enablePInvoke = true #else -// We currently build targeting netcoreapp2_1, and will continue to do so through this VS cycle -// but we can run on Netcoreapp3.0 so ... use reflection to invoke the api, when we are executing on netcoreapp3.0 +// Use reflection to invoke the api when we are executing on a platform that doesn't directly have this API. let definePInvokeMethod = typeof.GetMethod("DefinePInvokeMethod", [| typeof @@ -1541,13 +1540,12 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef) (* p.CharBestFit *) (* p.NoMangle *) -#if !FX_RESHAPED_REFEMIT || NETCOREAPP3_0 - // DefinePInvokeMethod was removed in early versions of coreclr, it was added back in NETCORE_APP3_0. +#if !FX_RESHAPED_REFEMIT || NETCOREAPP3_1 + // DefinePInvokeMethod was removed in early versions of coreclr, it was added back in NETCOREAPP3. // It has always been available in the desktop framework let methB = typB.DefinePInvokeMethod(mdef.Name, p.Where.Name, p.Name, attrs, cconv, rty, null, null, argtys, null, null, pcc, pcs) #else - // We currently build targeting netcoreapp2_1, and will continue to do so through this VS cycle - // but we can run on Netcoreapp3.0 so ... use reflection to invoke the api, when we are executing on netcoreapp3.0 + // Use reflection to invoke the api when we are executing on a platform that doesn't directly have this API. let methB = System.Diagnostics.Debug.Assert(definePInvokeMethod <> null, "Runtime does not have DefinePInvokeMethod") // Absolutely can't happen definePInvokeMethod.Invoke(typB, [| mdef.Name; p.Where.Name; p.Name; attrs; cconv; rty; null; null; argtys; null; null; pcc; pcs |]) :?> MethodBuilder diff --git a/src/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/src/buildtools/AssemblyCheck/AssemblyCheck.fsproj index cde9cb37a7..be43696d78 100644 --- a/src/buildtools/AssemblyCheck/AssemblyCheck.fsproj +++ b/src/buildtools/AssemblyCheck/AssemblyCheck.fsproj @@ -2,7 +2,7 @@ Exe - netcoreapp3.0 + netcoreapp3.1 true diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 4001b801aa..0469946c18 100755 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -245,11 +245,6 @@ type ConstraintSolverState = /// The function used to freshen values we encounter during trait constraint solving TcVal: TcValF - /// Indicates if the constraint solver is being run after type checking is complete, - /// e.g. during codegen to determine solutions and witnesses for trait constraints. - /// Suppresses the generation of certain errors such as missing constraint warnings. - codegen: bool - /// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable. /// That is, there will be one entry in this table for each free type variable in /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved @@ -262,7 +257,6 @@ type ConstraintSolverState = amap = amap ExtraCxs = HashMultiMap(10, HashIdentity.Structural) InfoReader = infoReader - codegen = false TcVal = tcVal } type ConstraintSolverEnv = @@ -867,34 +861,31 @@ let CheckWarnIfRigid (csenv: ConstraintSolverEnv) ty1 (r: Typar) ty = /// Add the constraint "ty1 = ty" to the constraint problem, where ty1 is a type variable. /// Propagate all effects of adding this constraint, e.g. to solve other variables -let rec SolveTyparEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) ty1 ty = trackErrors { - let m = csenv.m - do! DepthCheck ndeep m - match ty1 with - | TType_var r | TType_measure (Measure.Var r) -> - // The types may still be equivalent due to abbreviations, which we are trying not to eliminate - if typeEquiv csenv.g ty1 ty then () else - // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 - if occursCheck csenv.g r ty then return! ErrorD (ConstraintSolverInfiniteTypes(csenv.DisplayEnv, csenv.eContextInfo, ty1, ty, m, m2)) else - // Note: warn _and_ continue! - do! CheckWarnIfRigid csenv ty1 r ty - // Record the solution before we solve the constraints, since - // We may need to make use of the equation when solving the constraints. - // Record a entry in the undo trace if one is provided - trace.Exec (fun () -> r.typar_solution <- Some ty) (fun () -> r.typar_solution <- None) - - // Only solve constraints if this is not an error var - if r.IsFromError then () else - - // Check to see if this type variable is relevant to any trait constraints. - // If so, re-solve the relevant constraints. - if csenv.SolverState.ExtraCxs.ContainsKey r.Stamp then - do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) +let rec SolveTyparEqualsTypePart1 (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty1 r ty = trackErrors { + // The types may still be equivalent due to abbreviations, which we are trying not to eliminate + if typeEquiv csenv.g ty1 ty then () else + // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 + if occursCheck csenv.g r ty then return! ErrorD (ConstraintSolverInfiniteTypes(csenv.DisplayEnv, csenv.eContextInfo, ty1, ty, csenv.m, m2)) else + // Note: warn _and_ continue! + do! CheckWarnIfRigid csenv ty1 r ty + // Record the solution before we solve the constraints, since + // We may need to make use of the equation when solving the constraints. + // Record a entry in the undo trace if one is provided + trace.Exec (fun () -> r.typar_solution <- Some ty) (fun () -> r.typar_solution <- None) + } + +and SolveTyparEqualsTypePart2 (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) (r: Typar) ty = trackErrors { + // Only solve constraints if this is not an error var + if r.IsFromError then () else + + // Check to see if this type variable is relevant to any trait constraints. + // If so, re-solve the relevant constraints. + if csenv.SolverState.ExtraCxs.ContainsKey r.Stamp then + do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) + + // Re-solve the other constraints associated with this type variable + return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r - // Re-solve the other constraints associated with this type variable - return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r - - | _ -> failwith "SolveTyparEqualsType" } /// Apply the constraints on 'typar' to the type 'ty' @@ -939,6 +930,28 @@ and solveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty } +and SolveTyparEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) ty1 ty = trackErrors { + let m = csenv.m + do! DepthCheck ndeep m + match ty1 with + | TType_var r | TType_measure (Measure.Var r) -> + do! SolveTyparEqualsTypePart1 csenv m2 trace ty1 r ty + do! SolveTyparEqualsTypePart2 csenv ndeep m2 trace r ty + | _ -> failwith "SolveTyparEqualsType" + } + +// Like SolveTyparEqualsType but asserts all typar equalities simultaneously instead of one by one +and SolveTyparsEqualTypes (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) tptys tys = trackErrors { + do! (tptys, tys) ||> Iterate2D (fun tpty ty -> + match tpty with + | TType_var r | TType_measure (Measure.Var r) -> SolveTyparEqualsTypePart1 csenv m2 trace tpty r ty + | _ -> failwith "SolveTyparsEqualTypes") + do! (tptys, tys) ||> Iterate2D (fun tpty ty -> + match tpty with + | TType_var r | TType_measure (Measure.Var r) -> SolveTyparEqualsTypePart2 csenv ndeep m2 trace r ty + | _ -> failwith "SolveTyparsEqualTypes") + } + and SolveAnonInfoEqualsAnonInfo (csenv: ConstraintSolverEnv) m2 (anonInfo1: AnonRecdTypeInfo) (anonInfo2: AnonRecdTypeInfo) = if evalTupInfoIsStruct anonInfo1.TupInfo <> evalTupInfoIsStruct anonInfo2.TupInfo then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2)) else (match anonInfo1.Assembly, anonInfo2.Assembly with @@ -1945,14 +1958,14 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint | (TyparRigidity.Rigid | TyparRigidity.WillBeRigid), TyparConstraint.DefaultsTo _ -> true | _ -> false) then () - elif tp.Rigidity = TyparRigidity.Rigid && not csenv.SolverState.codegen then + elif tp.Rigidity = TyparRigidity.Rigid then return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else // It is important that we give a warning if a constraint is missing from a // will-be-made-rigid type variable. This is because the existence of these warnings // is relevant to the overload resolution rules (see 'candidateWarnCount' in the overload resolution // implementation). - if tp.Rigidity.WarnIfMissingConstraint && not csenv.SolverState.codegen then + if tp.Rigidity.WarnIfMissingConstraint then do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) let newConstraints = @@ -3065,8 +3078,7 @@ let CreateCodegenState tcVal g amap = amap = amap TcVal = tcVal ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = new InfoReader(g, amap) - codegen = true } + InfoReader = new InfoReader(g, amap) } /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code let CodegenWitnessForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { @@ -3083,7 +3095,7 @@ let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let ftps, _renaming, tinst = FreshenTypeInst m typars let traitInfos = GetTraitConstraintInfosOfTypars g ftps - do! SolveTypeEqualsTypeEqns csenv 0 m NoTrace None tinst tyargs + do! SolveTyparsEqualTypes csenv 0 m NoTrace tinst tyargs return MethodCalls.GenWitnessArgs amap g m traitInfos } @@ -3140,7 +3152,6 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = amap = amap TcVal = (fun _ -> failwith "should not be called") ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - codegen = false InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let minst = FreshenMethInfo m minfo diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index e620e4cac6..7e4b65f1a0 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -12,6 +12,9 @@ namespace Microsoft.FSharp.Core [] [] module String = + [] + let length (str:string) = if isNull str then 0 else str.Length + [] let concat sep (strings : seq) = String.Join(sep, strings) @@ -101,10 +104,3 @@ namespace Microsoft.FSharp.Core else let rec check i = (i < str.Length) && (predicate str.[i] || check (i+1)) check 0 - - [] - let length (str:string) = - if String.IsNullOrEmpty str then - 0 - else - str.Length diff --git a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs index 6fbd651671..d6aad41fe5 100644 --- a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs +++ b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs @@ -118,7 +118,7 @@ module internal Utilities = // In an sdk install we are always installed in: sdk\3.0.100-rc2-014234\FSharp // dotnet or dotnet.exe will be found in the directory that contains the sdk directory // 3. We are loaded in-process to some other application ... Eg. try .net - // See if the host is dotnet.exe ... from netcoreapp3.0 on this is fairly unlikely + // See if the host is dotnet.exe ... from netcoreapp3.1 on this is fairly unlikely // 4. If it's none of the above we are going to have to rely on the path containing the way to find dotnet.exe // if isRunningOnCoreClr then diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 1864bfed8c..e3ab13e193 100755 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -7,9 +7,12 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics +open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.InfoReader open FSharp.Compiler.Lib +open FSharp.Compiler.MethodCalls open FSharp.Compiler.PrettyNaming open FSharp.Compiler.Range open FSharp.Compiler.SyntaxTree @@ -746,7 +749,7 @@ let getDiscrim (EdgeDiscrim(_, discrim, _)) = discrim let CompilePatternBasic - g denv amap exprm matchm + (g: TcGlobals) denv amap tcVal infoReader exprm matchm warnOnUnused warnOnIncomplete actionOnFailure @@ -793,10 +796,47 @@ let CompilePatternBasic mkReraise matchm resultTy | Throw -> - // We throw instead of rethrow on unmatched try-catch in a computation expression. But why? - // Because this isn't a real .NET exception filter/handler but just a function we're passing + let findMethInfo ty isInstance name (sigTys: TType list) = + TryFindIntrinsicMethInfo infoReader matchm (AccessorDomain.AccessibleFromEverywhere) name ty + |> List.tryFind (fun methInfo -> + methInfo.IsInstance = isInstance && + ( + match methInfo.GetParamTypes(amap, matchm, []) with + | [] -> false + | argTysList -> + let argTys = (argTysList |> List.reduce (@)) @ [ methInfo.GetFSharpReturnTy (amap, matchm, []) ] + if argTys.Length <> sigTys.Length then + false + else + (argTys, sigTys) + ||> List.forall2 (typeEquiv g) + ) + ) + + // We use throw, or EDI.Capture(exn).Throw() when EDI is supported, instead of rethrow on unmatched try-catch in a computation expression. + // But why? Because this isn't a real .NET exception filter/handler but just a function we're passing // to a computation expression builder to simulate one. - mkThrow matchm resultTy (exprForVal matchm origInputVal) + let ediCaptureMethInfo, ediThrowMethInfo = + // EDI.Capture: exn -> EDI + g.system_ExceptionDispatchInfo_ty + |> Option.bind (fun ty -> findMethInfo ty false "Capture" [ g.exn_ty; ty ]), + // edi.Throw: unit -> unit + g.system_ExceptionDispatchInfo_ty + |> Option.bind (fun ty -> findMethInfo ty true "Throw" [ g.unit_ty ]) + + match Option.map2 (fun x y -> x,y) ediCaptureMethInfo ediThrowMethInfo with + | None -> + mkThrow matchm resultTy (exprForVal matchm origInputVal) + | Some (ediCaptureMethInfo, ediThrowMethInfo) -> + let (edi, _) = + BuildMethodCall tcVal g amap NeverMutates matchm false + ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal matchm origInputVal) ] + + let (e, _) = + BuildMethodCall tcVal g amap NeverMutates matchm false + ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] + + mkCompGenSequential matchm e (mkDefault (matchm, resultTy)) | ThrowIncompleteMatchException -> mkThrow matchm resultTy @@ -1335,7 +1375,7 @@ let CompilePatternBasic let isPartialOrWhenClause (c: TypedMatchClause) = isPatternPartial c.Pattern || c.GuardExpr.IsSome -let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (clausesL: TypedMatchClause list) inputTy resultTy = +let rec CompilePattern g denv amap tcVal infoReader exprm matchm warnOnUnused actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (clausesL: TypedMatchClause list) inputTy resultTy = match clausesL with | _ when List.exists isPartialOrWhenClause clausesL -> // Partial clauses cause major code explosion if treated naively @@ -1345,13 +1385,13 @@ let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (o let warnOnUnused = false // we can't turn this on since we're pretending all partials fail in order to control the complexity of this. let warnOnIncomplete = true let clausesPretendAllPartialFail = List.collect (fun (TClause(p, whenOpt, tg, m)) -> [TClause(erasePartialPatterns p, whenOpt, tg, m)]) clausesL - let _ = CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesPretendAllPartialFail inputTy resultTy + let _ = CompilePatternBasic g denv amap tcVal infoReader exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesPretendAllPartialFail inputTy resultTy let warnOnIncomplete = false let rec atMostOnePartialAtATime clauses = match List.takeUntil isPartialOrWhenClause clauses with | l, [] -> - CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) l inputTy resultTy + CompilePatternBasic g denv amap tcVal infoReader exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) l inputTy resultTy | l, (h :: t) -> // Add the partial clause. doGroupWithAtMostOnePartial (l @ [h]) t @@ -1372,10 +1412,10 @@ let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (o // Make the clause that represents the remaining cases of the pattern match let clauseForRestOfMatch = TClause(TPat_wild matchm, None, TTarget(List.empty, expr, spTarget), matchm) - CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (group @ [clauseForRestOfMatch]) inputTy resultTy + CompilePatternBasic g denv amap tcVal infoReader exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (group @ [clauseForRestOfMatch]) inputTy resultTy atMostOnePartialAtATime clausesL | _ -> - CompilePatternBasic g denv amap exprm matchm warnOnUnused true actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesL inputTy resultTy + CompilePatternBasic g denv amap tcVal infoReader exprm matchm warnOnUnused true actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesL inputTy resultTy diff --git a/src/fsharp/PatternMatchCompilation.fsi b/src/fsharp/PatternMatchCompilation.fsi index 67ca39e59b..e1833cdfe5 100755 --- a/src/fsharp/PatternMatchCompilation.fsi +++ b/src/fsharp/PatternMatchCompilation.fsi @@ -8,6 +8,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Range +open FSharp.Compiler.InfoReader /// What should the decision tree contain for any incomplete match? type ActionOnFailure = @@ -50,7 +51,10 @@ val ilFieldToTastConst: ILFieldInit -> Const val internal CompilePattern: TcGlobals -> DisplayEnv -> - Import.ImportMap -> + Import.ImportMap -> + // tcVal + (ValRef -> ValUseFlag -> TTypes -> range -> Expr * TType) -> + InfoReader -> // range of the expression we are matching on range -> // range to report "incomplete match" on diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index edc894a3f0..b574214ece 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1062,6 +1062,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val system_MarshalByRefObject_tcref = tryFindSysTyconRef sys "MarshalByRefObject" member val system_MarshalByRefObject_ty = tryMkSysNonGenericTy sys "MarshalByRefObject" + member val system_ExceptionDispatchInfo_ty = + tryMkSysNonGenericTy ["System"; "Runtime"; "ExceptionServices"] "ExceptionDispatchInfo" + member __.system_Reflection_MethodInfo_ty = v_system_Reflection_MethodInfo_ty member val system_Array_tcref = findSysTyconRef sys "Array" diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index ba63c4da3b..0be5b2cdfd 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3249,7 +3249,7 @@ let GetMethodArgs arg = //------------------------------------------------------------------------- let CompilePatternForMatch cenv (env: TcEnv) mExpr matchm warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy = - let dtree, targets = CompilePattern cenv.g env.DisplayEnv cenv.amap mExpr matchm warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy + let dtree, targets = CompilePattern cenv.g env.DisplayEnv cenv.amap (LightweightTcValForUsingInBuildMethodCall cenv.g) cenv.infoReader mExpr matchm warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy mkAndSimplifyMatch NoDebugPointAtInvisibleBinding mExpr matchm resultTy dtree targets /// Compile a pattern @@ -5535,7 +5535,6 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m)) [], args - | arg :: rest when numArgTys = 1 -> if numArgTys = 1 && not (List.isEmpty rest) then errorR (Error (FSComp.SR.tcUnionCaseRequiresOneArgument (), m)) @@ -5544,23 +5543,24 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | [arg] -> [arg], [] | args -> - errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) [], args let args, extraPatterns = let numArgs = args.Length if numArgs = numArgTys then args, extraPatterns + elif numArgs < numArgTys then + if numArgTys > 1 then + // Expects tuple without enough args + errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) + else + errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) + args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns else - if numArgs < numArgTys then - if numArgs <> 0 && numArgTys <> 0 then - errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) - args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns - else - let args, remaining = args |> List.splitAt numArgTys - for remainingArg in remaining do - errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, remainingArg.Range)) - args, extraPatterns @ remaining + let args, remaining = args |> List.splitAt numArgTys + for remainingArg in remaining do + errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, remainingArg.Range)) + args, extraPatterns @ remaining let extraPatterns = extraPatterns @ extraPatternsFromNames let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argTys args @@ -8570,6 +8570,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) | SynExpr.MatchBang (spMatch, expr, clauses, m) -> + let matchExpr = mkSourceExpr expr let mMatch = match spMatch with DebugPointAtBinding mMatch -> mMatch | _ -> m if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) @@ -8580,7 +8581,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder let consumeExpr = SynExpr.MatchLambda (false, mMatch, clauses, spMatch, mMatch) // TODO: consider allowing translation to BindReturn - Some(translatedCtxt (mkSynCall "Bind" mMatch [expr; consumeExpr])) + Some(translatedCtxt (mkSynCall "Bind" mMatch [matchExpr; consumeExpr])) | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> let mTry = match spTry with DebugPointAtTry.Yes m -> m | _ -> mTryToLast @@ -8883,6 +8884,7 @@ and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builder clauses |> List.forall (fun (Clause(_, _, clauseComp, _, _)) -> isSimpleExpr clauseComp) | SynExpr.YieldOrReturnFrom _ -> false | SynExpr.YieldOrReturn _ -> false + | SynExpr.DoBang _ -> false | _ -> true let basicSynExpr = @@ -9268,38 +9270,66 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = let cleanSynArg = stripParens synArg let m = cleanSynArg.Range - let rec check overallTyOpt expr (delayed: DelayedItem list) = + let rec check overallTyOpt resultOpt expr (delayed: DelayedItem list) = match expr with - | LongOrSingleIdent (false, (LongIdentWithDots((id::rest) as longId, _) as lidd), _, _) -> + | LongOrSingleIdent (false, (LongIdentWithDots(longId, _) as lidd), _, _) -> let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with - | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> - () // resolved to a module or namespace, done with checks - | _ -> - let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed - match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with - | Result tcref when IsEntityAccessible cenv.amap m ad tcref -> - () // resolved to a type name, done with checks - | _ -> - let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t - let _, _ = TcLongIdentThen cenv overallTy env tpenv lidd delayed - () // checked as an expression, done with checks - List.last longId + let result = defaultArg resultOpt (List.last longId) + let resolvedToModuleOrNamespaceName = + if delayed.IsEmpty then + let id,rest = List.headAndTail longId + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with + | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> + true // resolved to a module or namespace, done with checks + | _ -> + false + else + false + if resolvedToModuleOrNamespaceName then result else + + let resolvedToTypeName = + if (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) then + let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with + | Result tcref when (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) && IsEntityAccessible cenv.amap m ad tcref -> + true // resolved to a type name, done with checks + | _ -> + false + else + false + if resolvedToTypeName then result else + let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t + + // This will raise an error if resolution doesn't succeed + let _, _ = TcLongIdentThen cenv overallTy env tpenv lidd delayed + result // checked as an expression, done with checks + + // expr allowed, even with qualifications | SynExpr.TypeApp (hd, _, types, _, _, _, m) -> - check overallTyOpt hd (DelayedTypeApp(types, m, m) :: delayed) + check overallTyOpt resultOpt hd (DelayedTypeApp(types, m, m) :: delayed) + + // expr.ID allowed + | SynExpr.DotGet (hd, _, LongIdentWithDots(longId, _), _) -> + let result = defaultArg resultOpt (List.last longId) + check overallTyOpt (Some result) hd ((DelayedDotLookup (longId, expr.RangeSansAnyExtraDot)) :: delayed) - | SynExpr.Paren(expr, _, _, _) when overallTyOpt.IsNone && delayed.IsEmpty -> - check overallTyOpt expr [] + // "(expr)" allowed with no subsequent qualifications + | SynExpr.Paren(expr, _, _, _) when delayed.IsEmpty && overallTyOpt.IsNone -> + check overallTyOpt resultOpt expr delayed + // expr : type" allowed with no subsequent qualifications | SynExpr.Typed (synBodyExpr, synType, _m) when delayed.IsEmpty && overallTyOpt.IsNone -> let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType - check (Some tgtTy) synBodyExpr [] + check (Some tgtTy) resultOpt synBodyExpr delayed | _ -> error (Error(FSComp.SR.expressionHasNoName(), m)) - let lastIdent = check None cleanSynArg [] + let lastIdent = check None None cleanSynArg [] + TcNameOfExprResult cenv lastIdent m + +and TcNameOfExprResult cenv (lastIdent: Ident) m = let constRange = mkRange m.FileName m.Start (mkPos m.StartLine (m.StartColumn + lastIdent.idText.Length + 2)) // `2` are for quotes Expr.Const(Const.String(lastIdent.idText), constRange, cenv.g.string_ty) @@ -9822,8 +9852,21 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del // - it isn't a CtorValUsedAsSuperInit // - it isn't a CtorValUsedAsSelfInit // - it isn't a VSlotDirectCall (uses of base values do not take type arguments + // Allow `nameof<'T>` for a generic parameter + match vref with + | _ when isNameOfValRef cenv.g vref && cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf -> + match tys with + | [SynType.Var((Typar(id, _, false) as tp), _m)] -> + let _tp', tpenv = TcTyparOrMeasurePar None cenv env ImplicitlyBoundTyparsAllowed.NoNewTypars tpenv tp + let vexp = TcNameOfExprResult cenv id mExprAndTypeArgs + let vexpFlex = MakeApplicableExprNoFlex cenv vexp + PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex cenv.g.string_ty ExprAtomicFlag.Atomic otherDelayed + | _ -> + error (Error(FSComp.SR.expressionHasNoName(), mExprAndTypeArgs)) + | _ -> let checkTys tpenv kinds = TcTypesOrMeasures (Some kinds) cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mItem let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref (Some (NormalValUse, checkTys)) (Some afterResolution) mItem + let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) // We need to eventually record the type resolution for an expression, but this is done // inside PropagateThenTcDelayed, so we don't have to explicitly call 'CallExprHasTypeSink' here diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 416d04b520..7d10918c91 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2279,7 +2279,11 @@ val (|EnumExpr|_|) : TcGlobals -> Expr -> Expr option val (|TypeOfExpr|_|) : TcGlobals -> Expr -> TType option val (|TypeDefOfExpr|_|) : TcGlobals -> Expr -> TType option + +val isNameOfValRef: TcGlobals -> ValRef -> bool + val (|NameOfExpr|_|) : TcGlobals -> Expr -> TType option + val (|SeqExpr|_|) : TcGlobals -> Expr -> unit option val EvalLiteralExprOrAttribArg: TcGlobals -> Expr -> Expr diff --git a/tests/Directory.Build.targets b/tests/Directory.Build.targets index e28338a5d4..6df5fdfa9c 100644 --- a/tests/Directory.Build.targets +++ b/tests/Directory.Build.targets @@ -8,5 +8,11 @@ + + + + + + diff --git a/tests/FSharp.Test.Utilities/Assert.fs b/tests/FSharp.Test.Utilities/Assert.fs new file mode 100644 index 0000000000..d059337834 --- /dev/null +++ b/tests/FSharp.Test.Utilities/Assert.fs @@ -0,0 +1,23 @@ +namespace FSharp.Test.Utilities + +module Assert = + open FluentAssertions + open System.Collections + + let inline shouldBeEquivalentTo (expected : ^T) (actual : ^U) = + actual.Should().BeEquivalentTo(expected, "") |> ignore + + let inline shouldBe (expected : ^T) (actual : ^U) = + actual.Should().Be(expected, "") |> ignore + + let inline shouldBeEmpty (actual : ^T when ^T :> IEnumerable) = + actual.Should().BeEmpty("") |> ignore + + let inline shouldNotBeEmpty (actual : ^T when ^T :> IEnumerable) = + actual.Should().NotBeEmpty("") |> ignore + + let shouldBeFalse (actual: bool) = + actual.Should().BeFalse("") |> ignore + + let shouldBeTrue (actual: bool) = + actual.Should().BeTrue("") |> ignore diff --git a/tests/FSharp.TestHelpers/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs similarity index 98% rename from tests/FSharp.TestHelpers/CompilerAssert.fs rename to tests/FSharp.Test.Utilities/CompilerAssert.fs index 92552d17ad..4229611661 100644 --- a/tests/FSharp.TestHelpers/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.TestHelpers +namespace FSharp.Test.Utilities open System open System.Diagnostics @@ -19,7 +19,7 @@ open NUnit.Framework open System.Reflection.Emit open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.CSharp -open FSharp.TestHelpers.Utilities +open FSharp.Test.Utilities.Utilities [] type ILVerifier (dllFilePath: string) = @@ -125,7 +125,6 @@ let main argv = 0""" File.WriteAllText(programFsFileName, programFs) let pInfo = ProcessStartInfo () - pInfo.FileName <- config.DotNetExe pInfo.Arguments <- "build" pInfo.WorkingDirectory <- projectDirectory @@ -147,7 +146,7 @@ let main argv = 0""" cleanUp <- false printfn "%s" output printfn "%s" errors - raise (new Exception (sprintf "An error occured getting netcoreapp references: %A" e)) + raise (new Exception (sprintf "An error occurred getting netcoreapp references: %A" e)) finally if cleanUp then try Directory.Delete(projectDirectory) with | _ -> () @@ -420,6 +419,7 @@ let main argv = 0""" static member ExecutionHasOutput(cmpl: Compilation, expectedOutput: string) = CompilerAssert.Execute(cmpl, newProcess = true, onOutput = (fun output -> Assert.AreEqual(expectedOutput, output))) + /// Assert that the given source code compiles with the `defaultProjectOptions`, with no errors or warnings static member Pass (source: string) = lock gate <| fun () -> let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously diff --git a/tests/FSharp.TestHelpers/Directory.Build.props b/tests/FSharp.Test.Utilities/Directory.Build.props similarity index 100% rename from tests/FSharp.TestHelpers/Directory.Build.props rename to tests/FSharp.Test.Utilities/Directory.Build.props diff --git a/tests/FSharp.TestHelpers/FSharp.TestHelpers.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj similarity index 84% rename from tests/FSharp.TestHelpers/FSharp.TestHelpers.fsproj rename to tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 0dc048b156..a31ce7a77e 100644 --- a/tests/FSharp.TestHelpers/FSharp.TestHelpers.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -3,6 +3,9 @@ net472;netcoreapp3.0 netcoreapp3.0 + win-x86;win-x64;linux-x64;osx-x64 + net472;netcoreapp3.1 + netcoreapp3.1 win-x86;win-x64 $(AssetTargetFallback);portable-net45+win8+wp8+wpa81 true @@ -21,6 +24,7 @@ + @@ -39,6 +43,7 @@ - + + diff --git a/tests/FSharp.TestHelpers/ILChecker.fs b/tests/FSharp.Test.Utilities/ILChecker.fs similarity index 99% rename from tests/FSharp.TestHelpers/ILChecker.fs rename to tests/FSharp.Test.Utilities/ILChecker.fs index 9ddc810b81..9873a6ea81 100644 --- a/tests/FSharp.TestHelpers/ILChecker.fs +++ b/tests/FSharp.Test.Utilities/ILChecker.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.TestHelpers +namespace FSharp.Test.Utilities open System open System.IO diff --git a/tests/FSharp.TestHelpers/TestFramework.fs b/tests/FSharp.Test.Utilities/TestFramework.fs similarity index 76% rename from tests/FSharp.TestHelpers/TestFramework.fs rename to tests/FSharp.Test.Utilities/TestFramework.fs index 63ab601024..8cbb74880d 100644 --- a/tests/FSharp.TestHelpers/TestFramework.fs +++ b/tests/FSharp.Test.Utilities/TestFramework.fs @@ -18,13 +18,13 @@ module Commands = else Path.Combine(workDir, path) rooted |> Path.GetFullPath - let fileExists workDir path = + let fileExists workDir path = if path |> getfullpath workDir |> File.Exists then Some path else None - let directoryExists workDir path = + let directoryExists workDir path = if path |> getfullpath workDir |> Directory.Exists then Some path else None - let copy_y workDir source dest = + let copy_y workDir source dest = log "copy /y %s %s" source dest File.Copy( source |> getfullpath workDir, dest |> getfullpath workDir, true) CmdResult.Success @@ -35,7 +35,7 @@ module Commands = let rm dir path = let p = path |> getfullpath dir - if File.Exists(p) then + if File.Exists(p) then (log "rm %s" p) |> ignore File.Delete(p) else @@ -43,16 +43,16 @@ module Commands = let rmdir dir path = let p = path |> getfullpath dir - if Directory.Exists(p) then + if Directory.Exists(p) then (log "rmdir /sy %s" p) |> ignore Directory.Delete(p, true) else (log "not found: %s p") |> ignore - let pathAddBackslash (p: FilePath) = + let pathAddBackslash (p: FilePath) = if String.IsNullOrWhiteSpace (p) then p else - p.TrimEnd ([| Path.DirectorySeparatorChar; Path.AltDirectorySeparatorChar |]) + p.TrimEnd ([| Path.DirectorySeparatorChar; Path.AltDirectorySeparatorChar |]) + Path.DirectorySeparatorChar.ToString() let echoAppendToFile workDir text p = @@ -78,11 +78,11 @@ module Commands = match exitCode with | 0 -> CmdResult.Success - | err -> - let msg = sprintf "Error running command '%s' with args '%s' in directory '%s'" fscExe args workDir + | err -> + let msg = sprintf "Error running command '%s' with args '%s' in directory '%s'" fscExe args workDir CmdResult.ErrorLevel (msg, err) #else - ignore workDir + ignore workDir #if NETCOREAPP exec dotNetExe (fscExe + " " + args) #else @@ -119,7 +119,7 @@ module Commands = path -type TestConfig = +type TestConfig = { EnvironmentVariables : Map CSC : string csc_flags : string @@ -138,32 +138,61 @@ type TestConfig = ILDASM : string ILASM : string PEVERIFY : string - Directory: string + Directory: string DotNetExe: string DefaultPlatform: string} +#if NETCOREAPP +open System.Runtime.InteropServices +#endif -module WindowsPlatform = - let Is64BitOperatingSystem envVars = - // On Windows PROCESSOR_ARCHITECTURE has the value AMD64 on 64 bit Intel Machines - let value = - let find s = envVars |> Map.tryFind s - [| "PROCESSOR_ARCHITECTURE" |] |> Seq.tryPick (fun s -> find s) |> function None -> "" | Some x -> x - value = "AMD64" +let getOperatingSystem () = +#if NETCOREAPP + let isPlatform p = RuntimeInformation.IsOSPlatform(p) + if isPlatform OSPlatform.Windows then "win" + elif isPlatform OSPlatform.Linux then "linux" + elif isPlatform OSPlatform.OSX then "osx" + else "unknown" +#else + "win" +#endif -type FSLibPaths = +module DotnetPlatform = + let Is64BitOperatingSystem envVars = + match getOperatingSystem () with + | "win" -> + // On Windows PROCESSOR_ARCHITECTURE has the value AMD64 on 64 bit Intel Machines + let value = + let find s = envVars |> Map.tryFind s + [| "PROCESSOR_ARCHITECTURE" |] |> Seq.tryPick (fun s -> find s) |> function None -> "" | Some x -> x + value = "AMD64" + | _ -> System.Environment.Is64BitOperatingSystem // As an alternative for netstandard1.4+: System.Runtime.InteropServices.RuntimeInformation.ProcessArchitecture + +type FSLibPaths = { FSCOREDLLPATH : string } -let requireFile nm = - if Commands.fileExists __SOURCE_DIRECTORY__ nm |> Option.isSome then nm else failwith (sprintf "couldn't find %s. Running 'build test' once might solve this issue" nm) - -let packagesDir = +let getPackagesDir () = match Environment.GetEnvironmentVariable("NUGET_PACKAGES") with - | null -> Environment.GetEnvironmentVariable("USERPROFILE") ++ ".nuget" ++ "packages" + | null -> + let path = match Environment.GetEnvironmentVariable("USERPROFILE") with + | null -> Environment.GetEnvironmentVariable("HOME") + | p -> p + path ++ ".nuget" ++ "packages" | path -> path -let config configurationName envVars = +let requireFile dir path = + // Linux filesystems are (in most cases) case-sensitive. + // However when nuget packages are installed to $HOME/.nuget/packages, it seems they are lowercased + let fullPath = (dir ++ path) + match Commands.fileExists __SOURCE_DIRECTORY__ fullPath with + | Some _ -> fullPath + | None -> + let fullPathLower = (dir ++ path.ToLower()) + match Commands.fileExists __SOURCE_DIRECTORY__ fullPathLower with + | Some _ -> fullPathLower + | None -> failwith (sprintf "Couldn't find \"%s\" on the following paths: \"%s\", \"%s\". Running 'build test' once might solve this issue" path fullPath fullPathLower) +let config configurationName envVars = let SCRIPT_ROOT = __SOURCE_DIRECTORY__ #if NET472 let fscArchitecture = "net472" @@ -171,48 +200,62 @@ let config configurationName envVars = let fsharpCoreArchitecture = "net45" let fsharpBuildArchitecture = "net472" let fsharpCompilerInteractiveSettingsArchitecture = "net472" + let peverifyArchitecture = "net472" #else - let fscArchitecture = "netcoreapp3.0" - let fsiArchitecture = "netcoreapp3.0" + let fscArchitecture = "netcoreapp3.1" + let fsiArchitecture = "netcoreapp3.1" let fsharpCoreArchitecture = "netstandard2.0" - let fsharpBuildArchitecture = "netcoreapp3.0" + let fsharpBuildArchitecture = "netcoreapp3.1" let fsharpCompilerInteractiveSettingsArchitecture = "netstandard2.0" + let peverifyArchitecture = "netcoreapp3.0" #endif let repoRoot = SCRIPT_ROOT ++ ".." ++ ".." let artifactsPath = repoRoot ++ "artifacts" let artifactsBinPath = artifactsPath ++ "bin" let coreClrRuntimePackageVersion = "3.0.0-preview-27318-01" - let csc_flags = "/nologo" + let csc_flags = "/nologo" let fsc_flags = "-r:System.Core.dll --nowarn:20 --define:COMPILED" let fsi_flags = "-r:System.Core.dll --nowarn:20 --define:INTERACTIVE --maxerrors:1 --abortonerror" - let Is64BitOperatingSystem = WindowsPlatform.Is64BitOperatingSystem envVars + let operatingSystem = getOperatingSystem () + let Is64BitOperatingSystem = DotnetPlatform.Is64BitOperatingSystem envVars let architectureMoniker = if Is64BitOperatingSystem then "x64" else "x86" - let CSC = requireFile (packagesDir ++ "Microsoft.Net.Compilers" ++ "2.7.0" ++ "tools" ++ "csc.exe") - let ILDASM = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.ILDAsm") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "ildasm.exe") - let ILASM = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.ILAsm") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "ilasm.exe") - let coreclrdll = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.Runtime.CoreCLR") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "coreclr.dll") - let PEVERIFY = requireFile (artifactsBinPath ++ "PEVerify" ++ configurationName ++ "net472" ++ "PEVerify.exe") - let FSI_FOR_SCRIPTS = artifactsBinPath ++ "fsi" ++ configurationName ++ fsiArchitecture ++ "fsi.exe" - let FSharpBuild = requireFile (artifactsBinPath ++ "FSharp.Build" ++ configurationName ++ fsharpBuildArchitecture ++ "FSharp.Build.dll") - let FSharpCompilerInteractiveSettings = requireFile (artifactsBinPath ++ "FSharp.Compiler.Interactive.Settings" ++ configurationName ++ fsharpCompilerInteractiveSettingsArchitecture ++ "FSharp.Compiler.Interactive.Settings.dll") + let packagesDir = getPackagesDir () + let requirePackage = requireFile packagesDir + let requireArtifact = requireFile artifactsBinPath + let CSC = requirePackage ("Microsoft.Net.Compilers" ++ "2.7.0" ++ "tools" ++ "csc.exe") + let ILDASM_EXE = if operatingSystem = "win" then "ildasm.exe" else "ildasm" + let ILDASM = requirePackage (("runtime." + operatingSystem + "-" + architectureMoniker + ".Microsoft.NETCore.ILDAsm") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ (operatingSystem + "-" + architectureMoniker) ++ "native" ++ ILDASM_EXE) + let ILASM_EXE = if operatingSystem = "win" then "ilasm.exe" else "ilasm" + let ILASM = requirePackage (("runtime." + operatingSystem + "-" + architectureMoniker + ".Microsoft.NETCore.ILAsm") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ (operatingSystem + "-" + architectureMoniker) ++ "native" ++ ILASM_EXE) + let CORECLR_DLL = if operatingSystem = "win" then "coreclr.dll" elif operatingSystem = "osx" then "libcoreclr.dylib" else "libcoreclr.so" + let coreclrdll = requirePackage (("runtime." + operatingSystem + "-" + architectureMoniker + ".Microsoft.NETCore.Runtime.CoreCLR") ++ coreClrRuntimePackageVersion ++ "runtimes" ++ (operatingSystem + "-" + architectureMoniker) ++ "native" ++ CORECLR_DLL) + let PEVERIFY_EXE = if operatingSystem = "win" then "PEVerify.exe" else "PEVerify" + let PEVERIFY = requireArtifact ("PEVerify" ++ configurationName ++ peverifyArchitecture ++ PEVERIFY_EXE) + let FSharpBuild = requireArtifact ("FSharp.Build" ++ configurationName ++ fsharpBuildArchitecture ++ "FSharp.Build.dll") + let FSharpCompilerInteractiveSettings = requireArtifact ("FSharp.Compiler.Interactive.Settings" ++ configurationName ++ fsharpCompilerInteractiveSettingsArchitecture ++ "FSharp.Compiler.Interactive.Settings.dll") + let dotNetExe = // first look for {repoRoot}\.dotnet\dotnet.exe, otherwise fallback to %PATH% - let repoLocalDotnetPath = repoRoot ++ ".dotnet" ++ "dotnet.exe" + let DOTNET_EXE = if operatingSystem = "win" then "dotnet.exe" else "dotnet" + let repoLocalDotnetPath = repoRoot ++ ".dotnet" ++ DOTNET_EXE if File.Exists(repoLocalDotnetPath) then repoLocalDotnetPath - else "dotnet.exe" + else DOTNET_EXE + // ildasm + ilasm requires coreclr.dll to run which has already been restored to the packages directory - File.Copy(coreclrdll, Path.GetDirectoryName(ILDASM) ++ "coreclr.dll", overwrite=true) - File.Copy(coreclrdll, Path.GetDirectoryName(ILASM) ++ "coreclr.dll", overwrite=true) + File.Copy(coreclrdll, Path.GetDirectoryName(ILDASM) ++ CORECLR_DLL, overwrite=true) + File.Copy(coreclrdll, Path.GetDirectoryName(ILASM) ++ CORECLR_DLL, overwrite=true) - let FSI = requireFile (FSI_FOR_SCRIPTS) + let FSI_PATH = ("fsi" ++ configurationName ++ fsiArchitecture ++ "fsi.exe") + let FSI_FOR_SCRIPTS = requireArtifact FSI_PATH + let FSI = requireArtifact FSI_PATH #if !NETCOREAPP - let FSIANYCPU = requireFile (artifactsBinPath ++ "fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") + let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") #endif - let FSC = requireFile (artifactsBinPath ++ "fsc" ++ configurationName ++ fscArchitecture ++ "fsc.exe") - let FSCOREDLLPATH = requireFile (artifactsBinPath ++ "FSharp.Core" ++ configurationName ++ fsharpCoreArchitecture ++ "FSharp.Core.dll") + let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.exe") + let FSCOREDLLPATH = requireArtifact ("FSharp.Core" ++ configurationName ++ fsharpCoreArchitecture ++ "FSharp.Core.dll") - let defaultPlatform = - match Is64BitOperatingSystem with + let defaultPlatform = + match Is64BitOperatingSystem with // | PlatformID.MacOSX, true -> "osx.10.10-x64" // | PlatformID.Unix,true -> "ubuntu.14.04-x64" | true -> "win7-x64" @@ -223,7 +266,7 @@ let config configurationName envVars = ILDASM = ILDASM ILASM = ILASM PEVERIFY = PEVERIFY - CSC = CSC + CSC = CSC BUILD_CONFIG = configurationName FSC = FSC FSI = FSI @@ -234,9 +277,9 @@ let config configurationName envVars = FSharpBuild = FSharpBuild FSharpCompilerInteractiveSettings = FSharpCompilerInteractiveSettings csc_flags = csc_flags - fsc_flags = fsc_flags - fsi_flags = fsi_flags - Directory="" + fsc_flags = fsc_flags + fsi_flags = fsi_flags + Directory="" DotNetExe = dotNetExe DefaultPlatform = defaultPlatform } @@ -254,24 +297,25 @@ let logConfig (cfg: TestConfig) = #if !NETCOREAPP log "FSIANYCPU =%s" cfg.FSIANYCPU #endif + log "FSI_FOR_SCRIPTS =%s" cfg.FSI_FOR_SCRIPTS log "fsi_flags =%s" cfg.fsi_flags log "ILDASM =%s" cfg.ILDASM log "PEVERIFY =%s" cfg.PEVERIFY log "---------------------------------------------------------------" -let checkResult result = +let checkResult result = match result with | CmdResult.ErrorLevel (msg1, err) -> Assert.Fail (sprintf "%s. ERRORLEVEL %d" msg1 err) | CmdResult.Success -> () -let checkErrorLevel1 result = +let checkErrorLevel1 result = match result with | CmdResult.ErrorLevel (_,1) -> () | CmdResult.Success | CmdResult.ErrorLevel _ -> Assert.Fail (sprintf "Command passed unexpectedly") -let envVars () = - System.Environment.GetEnvironmentVariables () +let envVars () = + System.Environment.GetEnvironmentVariables () |> Seq.cast |> Seq.map (fun d -> d.Key :?> string, d.Value :?> string) |> Map.ofSeq @@ -279,15 +323,15 @@ let envVars () = let initializeSuite () = #if DEBUG - let configurationName = "debug" + let configurationName = "Debug" #else - let configurationName = "release" + let configurationName = "Release" #endif let env = envVars () let cfg = let c = config configurationName env - let usedEnvVars = c.EnvironmentVariables |> Map.add "FSC" c.FSC + let usedEnvVars = c.EnvironmentVariables |> Map.add "FSC" c.FSC { c with EnvironmentVariables = usedEnvVars } logConfig cfg @@ -303,7 +347,7 @@ type public InitializeSuiteAttribute () = override x.BeforeTest details = try - if details.IsSuite + if details.IsSuite then suiteHelpers.Force() |> ignore with | e -> raise (Exception("failed test suite initialization, debug code in InitializeSuiteAttribute", e)) @@ -334,28 +378,28 @@ type FileGuard(path: string) = member x.Path = path member x.Exists = x.Path |> File.Exists member x.CheckExists() = - if not x.Exists then + if not x.Exists then failwith (sprintf "exit code 0 but %s file doesn't exists" (x.Path |> Path.GetFileName)) interface IDisposable with member x.Dispose () = remove path - -type RedirectToType = + +type RedirectToType = | Overwrite of FilePath | Append of FilePath -type RedirectTo = +type RedirectTo = | Inherit | Output of RedirectToType | OutputAndError of RedirectToType * RedirectToType - | OutputAndErrorToSameFile of RedirectToType + | OutputAndErrorToSameFile of RedirectToType | Error of RedirectToType -type RedirectFrom = +type RedirectFrom = | RedirectInput of FilePath -type RedirectInfo = +type RedirectInfo = { Output : RedirectTo Input : RedirectFrom option } @@ -373,7 +417,7 @@ module Command = | Inherit -> "" | Output r-> sprintf " 1%s" (redirectType r) | OutputAndError (r1, r2) -> sprintf " 1%s 2%s" (redirectType r1) (redirectType r2) - | OutputAndErrorToSameFile r -> sprintf " 1%s 2>1" (redirectType r) + | OutputAndErrorToSameFile r -> sprintf " 1%s 2>1" (redirectType r) | Error r -> sprintf " 2%s" (redirectType r) sprintf "%s%s%s%s" path (match args with "" -> "" | x -> " " + x) (inF redirect.Input) (outF redirect.Output) @@ -402,13 +446,13 @@ module Command = let openWrite rt = let fullpath = Commands.getfullpath dir - match rt with + match rt with | Append p -> File.AppendText( p |> fullpath) | Overwrite p -> new StreamWriter(new FileStream(p |> fullpath, FileMode.Create)) let outF fCont cmdArgs = match redirect.Output with - | RedirectTo.Inherit -> + | RedirectTo.Inherit -> use toLog = redirectToLog () fCont { cmdArgs with RedirectOutput = Some (toLog.Post); RedirectError = Some (toLog.Post) } | Output r -> @@ -431,7 +475,7 @@ module Command = use outFile = redirectTo writer use toLog = redirectToLog () fCont { cmdArgs with RedirectOutput = Some (toLog.Post); RedirectError = Some (outFile.Post) } - + let exec cmdArgs = log "%s" (logExec dir path args redirect) Process.exec cmdArgs dir envVars path args @@ -491,7 +535,7 @@ let diff normalize path1 path2 = if not <| File.Exists(path1) then // creating empty baseline file as this is likely someone initializing a new test - File.WriteAllText(path1, String.Empty) + File.WriteAllText(path1, String.Empty) if not <| File.Exists(path2) then failwithf "Invalid path %s" path2 let lines1 = File.ReadAllLines(path1) @@ -523,7 +567,7 @@ let diff normalize path1 path2 = result.ToString() -let fsdiff cfg a b = +let fsdiff cfg a b = let actualFile = System.IO.Path.Combine(cfg.Directory, a) let expectedFile = System.IO.Path.Combine(cfg.Directory, b) let errorText = System.IO.File.ReadAllText (System.IO.Path.Combine(cfg.Directory, a)) @@ -535,8 +579,8 @@ let fsdiff cfg a b = log "%s" errorText result - -let requireENCulture () = + +let requireENCulture () = match System.Globalization.CultureInfo.CurrentCulture.TwoLetterISOLanguageName with | "en" -> true | _ -> false diff --git a/tests/FSharp.TestHelpers/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs similarity index 99% rename from tests/FSharp.TestHelpers/Utilities.fs rename to tests/FSharp.Test.Utilities/Utilities.fs index ebf201b0f1..8509a0cee5 100644 --- a/tests/FSharp.TestHelpers/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.TestHelpers +namespace FSharp.Test.Utilities open System open System.IO @@ -8,7 +8,7 @@ open System.Collections.Immutable open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.CSharp open System.Diagnostics -open FSharp.TestHelpers +open FSharp.Test.Utilities // This file mimics how Roslyn handles their compilation references for compilation testing diff --git a/tests/README.md b/tests/README.md new file mode 100644 index 0000000000..59ad0678aa --- /dev/null +++ b/tests/README.md @@ -0,0 +1,109 @@ +# F# Testing proposal + +## Why do we test + +* To prevent regressions (behavioral, performance). +* To have a quicker debug feedback (thus, find problems quicker). +* To verify conformance to language spec (API contract testing). +* To have IL verification (both read and write). +* To have a quicker design feedback. +* To document behavior. + +## Goals + +* Use one standardized testing framework across all of test projects, and get rid of custom old solutions (FSharpQA and Cambridge suites). +* Have tests restructured the way, that they are easy to discover. +* Have tests building and running on all supported platforms (Windows, macOS and Linux) and different frameworks (with exceptions when this is not applicable). +* Make it easy to run tests using standard .NET instruments (dotnet cli, test explorer, etc.). +* Leverage standard .NET testing platform and use all its benefits, suck as live unit testing, code coverage collecting, dead code elimination, etc. + +## Framework for testing + +The following test frameworks and libraries will be used for new test projects **[xUnit Test Framework](https://xunit.net/), [FluentAssertions](https://fluentassertions.com/) (+ [FsUnit](https://fsprojects.github.io/FsUnit/) and [FsCheck](https://github.com/fscheck/FsCheck) when needed)**. All existing NUnit test suites will be migrated to xUnit. + +**Justification:** + +* **xUnit** is an extensible, TDD adherent, testing framework, which was successfully adopted by many .NET engineering teams, including Roslyn, AspNetCore, EFcore, etc, has a "cleaner" approach for writing test suites (i.e. class constructor for setup, implementing IDisposable for teardown, as oppose to custom attributes). More info [here](https://xunit.net/docs/comparisons). +* **FluentAssertions** makes it easier to write scoped assertions, provides better error messages. + +**Alternatives:** NUnit, MSBuild, Expecto + +### Tests categorization + +#### New tests should be grouped based on two factors: test type (1) + test category and subcategory (2) + +1. **Test type**: +**Determines what type of test is it:** + * __Functional tests__: + * __Unit Tests__: a lightweight testing for smaller modules, functions, etc. + * __Examples__: Testing individual parts/functions of lexer, parser, syntax tree, standard library modules, etc. + * __Subgroups__: there should be a separation between testing private and public parts of each module (i.e. compiler tests for private and public API should be in separate test projects). + * __Component Tests__: testing for bigger parts of compiler. + * __Examples__: Tests for the compiler components as whole, such as Code generation, IL Generation, Compiler optimizations, Type Checker, Type Providers, Conformance, etc. + * __Integration and End2End Tests__: testing of F# compiler & tooling integration, as well as e2e experiences. + * __Examples__: VS Integration, .NET Interactive integration, LSP integration. Integration with dotnet CLI, project creation, building, running. + * __Non-functional tests__: + * __Load and Stress Tests__: testing for high level modules/components to understand peak performance and potentially catch any performance regressions. + * __Examples__: measuring compile, build, link times for the compiler, individual functions (i.e. data structures sorting, traversing, etc.). +1. **Test category and subcategory**: Tests (sub)categories shall be determined by the project, library, module, and functionality tests are covering. + +#### Examples + +* F# compiler component test which is verifying generated IL for computation expression will have category `Compiler` and subcategories `EmittedIL` and `ComputationExpressions`. +* F# compiler service unit test which is testing F# tokenizer, will have category `Compiler.Service` and subcategory `Tokenizer`. + +Please, refer to [File and project structure](#File-and-project-structure) for more information on how tests will be organized on the filesystem. + +## File and project structure + +### Naming schema + +The proposed naming schema for test projects is: `FSharp.Category.Subcategory.TestType`, where +`Category.Subcategory` is either a corresponding source project, or a more generic component (e.g. `Compiler`, `Compiler.Private` or more granular `Compiler.CodeGen`, `Compiler.CodeGen.EmittedIL` if category or subcategory project becomes too big, etc.) and `TestType` is the type of the test (one of `UnitTests`, `ComponentTests`, `IntegrationTests`, `LoadTests`). + +### Projects organization + +Please refer to the "[Naming schema](#Naming-schema)" section above for more information on the projects naming. + +New test projects will be grouped by category and test type, all subcategories are just test folders/files in the test project. + +* __Examples__: Having test project organized like: + > `tests/FSharp.Compiler.ComponentTests/CodeGen/EmittedIL/BasicTests.fs` + > `tests/FSharp.Compiler.ComponentTests/CodeGen/StringEncoding/StringTests.fs` + > `tests/FSharp.Compiler.ComponentTests/Optimizations/Inlining/InliningTests.fs` + + Will result in one test dll "`FSharp.Compiler.ComponentTests.dll`" which will contain all the subcategories of tests. +* **Notes**: + * This will result in reduced fragmentation of tests, all the tests files are under one big category, easier to understand what each component/unit test suite covers, less confusion in test classification for new tests. + * If some categories (or subcategories) will become big enough - they can be factored out to a separate project. + +### Test Utilities/Helpers + +For all new and migrated tests, any common/helper functionality shall be factored out to a separate project - `FSharp.Test.Utilities`. + +## New tests + +* All new tests should be created in the new projects only. +* All new tests should contain a brief docstring description of what is being tested, link to an issue if applicable. +* All new tests should be categorized using xUnit's `Trait`, based on their `Category` and `Subcategories`. + +## Migrating existing tests + +Existing FSharpQA and Cambridge need to be migrated to corresponding test projects: component-style tests to the `FSharp.Compiler.ComponentTests` and unittest-style tests - `FSharp.Compiler.UnitTests`, `FSharp.Compiler.Private.Scripting.UnitTests`, `FSharp.Build.UnitTests`, etc. + +## Next steps + +* [**In Progress**] Migrate existing `NUnit` tests to xUnit. +* Clean up CompilerAssert. +* Make PEVerify tests work in netcore/non-windows environment. +* Start migration of existing (namely, FSharpQA and Cambridge) suites to xUnit-based projects. + +## Open questions: + +* As far as I know, [FSharp.Compiler.Service](https://github.com/fsharp/FSharp.Compiler.Service) is dependant on some of the F# compiler tests. Does it have to be changed as well? + +## Other + +Related issues: (https://github.com/dotnet/fsharp/issues/7075) + +You can find this document under 'tests/README.md'. diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 60f6327d3c..b426147393 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -80,7 +80,7 @@ match A with """ assertHasSymbolUsages ["x"; "y"] checkResults dumpErrors checkResults |> shouldEqual [ - "(7,2--7,10): This constructor is applied to 2 argument(s) but expects 3" + "(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)." ] @@ -257,6 +257,23 @@ match TraceLevel.Off with ] +[] +let ``Caseless DU`` () = + let _, checkResults = getParseAndCheckResults """ +type DU = Case of int + +let f du = + match du with + | Case -> () + +let dowork () = + f (Case 1) + 0 // return an integer exit code""" + assertHasSymbolUsages ["DU"; "dowork"; "du"; "f"] checkResults + dumpErrors checkResults |> shouldEqual [ + "(6,6--6,10): This constructor is applied to 0 argument(s) but expects 1" + ] + [] let ``Or 01 - No errors`` () = let _, checkResults = getParseAndCheckResults """