Support multithreaded MSBuild in F# build tasks

azure-pipelines-PR.yml

@@ -494,8 +494,15 @@ stages:
           steps:
           - checkout: self
             clean: true
-          - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr
+          - script: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclr --mt true
             displayName: Build / Test
+          - script: ./eng/common/dotnet.sh fsi tests/EndToEndBuildTests/MultithreadedTasks/run.fsx -- --configuration $(_BuildConfig) --repetitions 3
+            displayName: Real SDK MP / MT integration
+          - task: PublishPipelineArtifact@1
+            condition: always()
+            inputs:
+              targetPath: '$(Build.SourcesDirectory)/artifacts/MultithreadedTasks'
+              artifact: Linux SDK MT evidence
           - task: PublishTestResults@2
             displayName: Publish Test Results
             inputs:
@@ -543,7 +550,7 @@ stages:
           steps:
           - template: /eng/templates/batched-test-steps.yml
             parameters:
-              buildCommand: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclrbatch $(batchNumber)
+              buildCommand: ./eng/cibuild.sh --configuration $(_BuildConfig) --testcoreclrbatch $(batchNumber) --mt true
               buildEnv:
                 COMPlus_DefaultStackSize: 1000000
               testRunTitlePrefix: 'MacOS'
@@ -566,6 +573,13 @@ stages:
             displayName: Verify FSharp.Core package assets
           - script: .\tests\EndToEndBuildTests\EndToEndBuildTests.cmd -c Release
             displayName: End to end build tests
+          - script: .\eng\common\dotnet.cmd fsi tests\EndToEndBuildTests\MultithreadedTasks\run.fsx -- --configuration Release --repetitions 3
+            displayName: Real SDK MP / MT integration
+          - task: PublishPipelineArtifact@1
+            condition: always()
+            inputs:
+              targetPath: '$(Build.SourcesDirectory)/artifacts/MultithreadedTasks'
+              artifact: Windows SDK MT evidence
 
           # Publish artifacts for regression testing
           - task: PublishPipelineArtifact@1
@@ -637,7 +651,7 @@ stages:
             clean: true
           - script: dotnet --list-sdks
             displayName: Report dotnet SDK versions
-          - script: .\eng\common\dotnet.cmd build .\FSharp.Compiler.Service.slnx /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
+          - script: .\eng\common\dotnet.cmd build .\FSharp.Compiler.Service.slnx -mt /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
             workingDirectory: $(Build.SourcesDirectory)
             displayName: Regular rebuild of FSharp.Compiler.Service.slnx
             continueOnError: false
@@ -656,7 +670,7 @@ stages:
             clean: true
           - script: dotnet --list-sdks
             displayName: Report dotnet SDK versions
-          - script: ./eng/common/dotnet.sh build ./FSharp.Compiler.Service.slnx /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
+          - script: ./eng/common/dotnet.sh build ./FSharp.Compiler.Service.slnx -mt /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
             workingDirectory: $(Build.SourcesDirectory)
             displayName: Regular rebuild of FSharp.Compiler.Service.slnx
             continueOnError: false
@@ -674,7 +688,7 @@ stages:
             clean: true
           - script: dotnet --list-sdks
             displayName: Report dotnet SDK versions
-          - script: ./eng/common/dotnet.sh build ./FSharp.Compiler.Service.slnx /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
+          - script: ./eng/common/dotnet.sh build ./FSharp.Compiler.Service.slnx -mt /bl:\"artifacts/log/$(_BuildConfig)/ServiceRegularBuild.binlog\"
             workingDirectory: $(Build.SourcesDirectory)
             displayName: Regular rebuild of FSharp.Compiler.Service.slnx
             continueOnError: false

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -205,6 +205,7 @@
 * `Async.RunImmediate` renamed and replaced with impl of `FSharp.Core`'s `Async.RunSynchronouslyImmediate`, wherein `Exception`s are unwrapped (i.e., no egregious `AggregateException` wrapping). ([Issue #1042](https://github.com/fsharp/fslang-suggestions/issues/1042), [PR #19804](https://github.com/dotnet/fsharp/pull/19804), [PR #20245](https://github.com/dotnet/fsharp/pull/20245))
 * Lower string-typed interpolated strings to `System.String.Concat` rather than the reflection-based `printf` engine, making them trim- and NativeAOT-compatible. This generalizes and ungates the previous all-string `String.Concat` optimization, so it now applies to every string-typed interpolation. ([Language suggestion #1108](https://github.com/fsharp/fslang-suggestions/issues/1108), [PR #19971](https://github.com/dotnet/fsharp/pull/19971))
 * Stabilized several `preview` language features into F# 11.0 (`--langversion:11.0`, enabled by default with a .NET 11 SDK): `MethodOverloadsCache`, `ErrorOnMissingSignatureAttribute`, `DirectDelegateConstruction`, `AccessProtectedBaseFieldFromClosure`, and `RecordSpreads`. `FromEndSlicing` intentionally remains in `preview`. ([PR #20199](https://github.com/dotnet/fsharp/pull/20199))
+* F# build tasks use MSBuild's per-task environment for in-process multithreaded builds. The build host must provide `IMultiThreadableTask`, `TaskEnvironment`, and `ToolTask.TaskEnvironment`. ([PR #20506](https://github.com/dotnet/fsharp/pull/20506))
 * Interpolated string holes (e.g. `$"{x}"`) are now formatted with invariant culture (via the `string` operator) instead of the current thread culture. ([PR #19971](https://github.com/dotnet/fsharp/pull/19971))
 * Lines starting with `#:` are now ignored ([Language suggestion 1440](https://github.com/fsharp/fslang-suggestions/issues/1440), [RFC FS-1337](https://github.com/fsharp/fslang-design/pull/830), [PR #20212](https://github.com/dotnet/fsharp/pull/20212))
 * `[<return: X>]` attributes written in front of a binding are again reported by `SynBinding.attributes` in the untyped syntax tree, with their original grouping and `[< >]` ranges. The rotation into `SynValInfo.retInfo` added by [PR #19738](https://github.com/dotnet/fsharp/pull/19738) now happens while normalizing a binding for checking instead of in the parser, so both fixes from that PR are unchanged while tools reading the parse tree (formatters, analyzers, source generators) again see what was written. ([PR #20356](https://github.com/dotnet/fsharp/pull/20356))

src/Compiler/Facilities/CompilerLocation.fs

@@ -67,12 +67,12 @@ module internal FSharpEnvironment =
     //     - default F# binaries directory in service.fs (REVIEW: check this)
     //     - default location of fsi.exe in FSharp.VS.FSI.dll (REVIEW: check this)
     //     - default F# binaries directory in (project system) Project.fs
-    let BinFolderOfDefaultFSharpCompiler (probePoint: string option) =
+    let BinFolderOfDefaultFSharpCompilerUsingEnvironment (getEnvironmentVariable: string -> string | null) (probePoint: string option) =
         // Check for an app.config setting to redirect the default compiler location
         // Like fsharp-compiler-location
         try
             // We let you set FSHARP_COMPILER_BIN. I've rarely seen this used and its not documented in the install instructions.
-            match Environment.GetEnvironmentVariable("FSHARP_COMPILER_BIN") with
+            match getEnvironmentVariable "FSHARP_COMPILER_BIN" with
             | result when not (String.IsNullOrWhiteSpace result) -> Some !!result
             | _ ->
                 let safeExists f =
@@ -96,6 +96,9 @@ module internal FSharpEnvironment =
         with e ->
             None
 
+    let BinFolderOfDefaultFSharpCompiler (probePoint: string option) =
+        BinFolderOfDefaultFSharpCompilerUsingEnvironment Environment.GetEnvironmentVariable probePoint
+
     // Specify the tooling-compatible fragments of a path such as:
     //     typeproviders/fsharp41/net461/MyProvider.DesignTime.dll
     //     tools/fsharp41/net461/MyProvider.DesignTime.dll

src/Compiler/Facilities/CompilerLocation.fsi

@@ -28,6 +28,11 @@ module internal FSharpEnvironment =
     //     - default F# binaries directory in (project system) Project.fs
     val BinFolderOfDefaultFSharpCompiler: probePoint: string option -> string option
 
+    // As BinFolderOfDefaultFSharpCompiler, but FSHARP_COMPILER_BIN is read via the given accessor so
+    // multi-threadable tasks resolve against their own TaskEnvironment.
+    val BinFolderOfDefaultFSharpCompilerUsingEnvironment:
+        getEnvironmentVariable: (string -> string | null) -> probePoint: string option -> string option
+
     val toolingCompatiblePaths: unit -> string list
 
     val searchToolPaths: path: string option -> compilerToolPaths: seq<string> -> seq<string>

src/FSharp.Build/CreateFSharpManifestResourceName.fs

@@ -4,8 +4,10 @@ namespace FSharp.Build
 
 open System
 open System.IO
+open Microsoft.Build.Framework
 open Microsoft.Build.Tasks
 
+[<MSBuildMultiThreadableTask>]
 type CreateFSharpManifestResourceName public () =
     inherit CreateCSharpManifestResourceName()
 

src/FSharp.Build/FSharp.Build.fsproj

@@ -33,11 +33,13 @@
 
   <ItemGroup>
     <InternalsVisibleTo Include="VisualFSharp.UnitTests" />
+    <InternalsVisibleTo Include="FSharp.Build.UnitTests" />
     <Compile Include="..\Compiler\Utilities\NullHelpers.fs" />
     <EmbeddedText Include="FSBuild.txt" />
     <EmbeddedText Include="..\Compiler\Facilities\UtilsStrings.txt" />
     <Compile Include="..\Compiler\Facilities\CompilerLocation.fs" />
     <Compile Include="FSharpCommandLineBuilder.fs" />
+    <Compile Include="TaskEnvironmentPaths.fs" />
     <Compile Include="Fsc.fs" />
     <Compile Include="Fsi.fs" />
     <Compile Include="FSharpEmbedResourceText.fs" />

src/FSharp.Build/FSharpEmbedResXSource.fs

@@ -10,13 +10,18 @@ open System.Xml.Linq
 open Microsoft.Build.Framework
 open Microsoft.Build.Utilities
 
+[<MSBuildMultiThreadableTask>]
 type FSharpEmbedResXSource() as this =
     inherit Task()
     let mutable _embeddedText: ITaskItem[] = [||]
     let mutable _generatedSource: ITaskItem[] = [||]
     let mutable _outputPath: string = ""
     let mutable _targetFramework: string = ""
 
+    // Bound against `this` once; each call reads the injected TaskEnvironment late.
+    let rootedPath = TaskEnvironmentPaths.rootedPath this
+    let restorePaths = TaskEnvironmentPaths.restoreTaskPaths this
+
     let failTask fmt =
         Printf.ksprintf
             (fun msg ->
@@ -41,16 +46,24 @@ module internal {1} =
         "    let GetObject(name:System.String) : System.Object = ResourceManager.GetObject(name, CultureInfo.CurrentUICulture)"
 
     let generateSource (resx: string) (fullModuleName: string) (generateLegacy: bool) (generateLiteral: bool) =
+        // Record paths inside the try so failures during derivation still reach the shared handler below.
+        let mutable originalPaths = [ resx ]
+
         try
-            let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt
             let justFileName = Path.GetFileNameWithoutExtension(resx)
             let sourcePath = Path.Combine(_outputPath, justFileName + ".fs")
+            originalPaths <- [ resx; sourcePath ]
+
+            let rootedResx = rootedPath resx
+            let rootedSource = rootedPath sourcePath
+
+            let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt
 
             // simple up-to-date check
             if
-                File.Exists(resx)
-                && File.Exists(sourcePath)
-                && File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath)
+                File.Exists rootedResx
+                && File.Exists rootedSource
+                && File.GetLastWriteTimeUtc rootedResx <= File.GetLastWriteTimeUtc rootedSource
             then
                 printMessage "Skipping generation: '%s' since it is up-to-date." sourcePath
                 Some(sourcePath)
@@ -82,7 +95,7 @@ module internal {1} =
                 let body =
                     let xname = XName.op_Implicit
 
-                    XDocument.Load(resx).Descendants(xname "data")
+                    XDocument.Load(rootedResx).Descendants(xname "data")
                     |> Seq.fold
                         (fun (sb: StringBuilder) (node: XElement) ->
                             let name =
@@ -120,13 +133,21 @@ module internal {1} =
                             sb.AppendLine().Append(commentBody).AppendLine(accessorBody))
                         sb
 
-                File.WriteAllText(sourcePath, body.ToString())
+                File.WriteAllText(rootedSource, body.ToString())
                 printMessage "Done: %s" sourcePath
                 Some(sourcePath)
-        with e ->
-            printf "An exception occurred when processing '%s'\n%s" resx (e.ToString())
+        with
+        | TaskFailed ->
+            // failTask already logged the error; re-logging would duplicate the diagnostic.
+            None
+        | e ->
+            this.Log.LogError(sprintf "An exception occurred when processing '%s': %s" resx (restorePaths (e.ToString()) originalPaths))
+
             None
 
+    interface IMultiThreadableTask with
+        member val TaskEnvironment = TaskEnvironment.Fallback with get, set
+
     [<Required>]
     member _.EmbeddedResource
         with get () = _embeddedText
@@ -155,9 +176,7 @@ module internal {1} =
                     | "false" -> false
                     | _ -> failTask "Expected boolean value for '%s' found '%s'" metadataName value
 
-            let mutable success = true
-
-            let generatedSource =
+            let generationResults =
                 [|
                     for item in this.EmbeddedResource do
                         if getBooleanMetadata "GenerateSource" false item then
@@ -170,12 +189,12 @@ module internal {1} =
                             let generateLegacy = getBooleanMetadata "GenerateLegacyCode" false item
                             let generateLiteral = getBooleanMetadata "GenerateLiterals" true item
 
-                            match generateSource item.ItemSpec moduleName generateLegacy generateLiteral with
-                            | Some(source) -> yield TaskItem(source) :> ITaskItem
-                            | None -> success <- false
+                            yield
+                                generateSource item.ItemSpec moduleName generateLegacy generateLiteral
+                                |> Option.map (fun source -> TaskItem(source) :> ITaskItem)
                 |]
 
-            _generatedSource <- generatedSource
-            success && not this.Log.HasLoggedErrors
+            _generatedSource <- generationResults |> Array.choose id
+            Array.forall Option.isSome generationResults && not this.Log.HasLoggedErrors
         with TaskFailed ->
             false