diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index df52d62e7f2..1ec3b5add20 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -25,7 +25,7 @@ * Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887)) * Completion: fix for unfinished record field decl ([PR #16893](https://github.com/dotnet/fsharp/pull/16893)) * Enforce AttributeTargets on delegates ([PR #16891](https://github.com/dotnet/fsharp/pull/16891)) - +* Fix StackOverflow when checking non-recursive bindings in module or namespace in `fscAnyCpu`/`fsiAnyCpu`. ([PR #16908](https://github.com/dotnet/fsharp/pull/16908)) ### Added diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index d64c1b648f5..f1037f7f1bb 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4,6 +4,7 @@ module internal FSharp.Compiler.CheckDeclarations open System open System.Collections.Generic +open System.Threading open FSharp.Compiler.Diagnostics open Internal.Utilities.Collections @@ -5330,22 +5331,29 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem } /// The non-mutually recursive case for a sequence of declarations -and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) = - cancellable { - match moreDefs with - | firstDef :: otherDefs -> - // Lookahead one to find out the scope of the next declaration. - let scopem = - if isNil otherDefs then unionRanges firstDef.Range endm - else unionRanges (List.head otherDefs).Range endm +and [] TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, env, envAtEnd) (moreDefs: SynModuleDecl list) (ct: CancellationToken) = + + if ct.IsCancellationRequested then + ValueOrCancelled.Cancelled (OperationCanceledException()) + else + match moreDefs with + | [] -> + ValueOrCancelled.Value (List.rev defsSoFar, envAtEnd) + | firstDef :: otherDefs -> + // Lookahead one to find out the scope of the next declaration. + let scopem = + if isNil otherDefs then + unionRanges firstDef.Range endm + else + unionRanges (List.head otherDefs).Range endm - let! firstDef, env, envAtEnd = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef + let result = Cancellable.run ct (TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef) - // tail recursive - return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ( (firstDef :: defsSoFar), env, envAtEnd) otherDefs - | [] -> - return List.rev defsSoFar, envAtEnd - } + match result with + | ValueOrCancelled.Cancelled x -> + ValueOrCancelled.Cancelled x + | ValueOrCancelled.Value(firstDef, env, envAtEnd) -> + TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ((firstDef :: defsSoFar), env, envAtEnd) otherDefs ct /// The mutually recursive case for a sequence of declarations (and nested modules) and TcModuleOrNamespaceElementsMutRec (cenv: cenv) parent typeNames m envInitial mutRecNSInfo (defs: SynModuleDecl list) = @@ -5470,20 +5478,24 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 escapeCheck() return (moduleContents, topAttrsNew, envAtEnd) - | None -> - - let! compiledDefs, envAtEnd = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) synModuleDecls - - // Apply the functions for each declaration to build the overall expression-builder - let moduleDefs = List.collect p13 compiledDefs - let moduleDefs = match openDecls0 with [] -> moduleDefs | _ -> TMDefOpens openDecls0 :: moduleDefs - let moduleContents = TMDefs moduleDefs + | None -> + let! ct = Cancellable.token () + let result = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) synModuleDecls ct + + match result with + | ValueOrCancelled.Value(compiledDefs, envAtEnd) -> + // Apply the functions for each declaration to build the overall expression-builder + let moduleDefs = List.collect p13 compiledDefs + let moduleDefs = match openDecls0 with [] -> moduleDefs | _ -> TMDefOpens openDecls0 :: moduleDefs + let moduleContents = TMDefs moduleDefs + + // Collect up the attributes that are global to the file + let topAttrsNew = List.collect p33 compiledDefs + return (moduleContents, topAttrsNew, envAtEnd) + | ValueOrCancelled.Cancelled x -> + return! Cancellable(fun _ -> ValueOrCancelled.Cancelled x) + } - // Collect up the attributes that are global to the file - let topAttrsNew = compiledDefs |> List.collect p33 - return (moduleContents, topAttrsNew, envAtEnd) - } - //-------------------------------------------------------------------------- // CheckOneImplFile - Typecheck all the namespace fragments in a file. diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 75dfaaef39e..d93a3a60b6c 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -11,6 +11,8 @@ open System open System.Diagnostics open System.Reflection open System.Threading +open System.Runtime.CompilerServices +open System.Runtime.InteropServices open Internal.Utilities.Library open Internal.Utilities.Library.Extras open System.Collections.Concurrent @@ -853,7 +855,25 @@ type StackGuard(maxDepth: int, name: string) = let mutable depth = 1 [] - member _.Guard(f) = + member _.Guard + ( + f, + [] memberName: string, + [] path: string, + [] line: int + ) = + use _ = + Activity.start + "DiagnosticsLogger.StackGuard.Guard" + [| + Activity.Tags.stackGuardName, name + Activity.Tags.stackGuardCurrentDepth, string depth + Activity.Tags.stackGuardMaxDepth, string maxDepth + Activity.Tags.callerMemberName, memberName + Activity.Tags.callerFilePath, path + Activity.Tags.callerLineNumber, string line + |] + depth <- depth + 1 try diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index bcbdd197b73..ec2d37bc040 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -6,6 +6,8 @@ open System open FSharp.Compiler.Diagnostics open FSharp.Compiler.Features open FSharp.Compiler.Text +open System.Runtime.CompilerServices +open System.Runtime.InteropServices /// Represents the style being used to format errors [] @@ -448,7 +450,12 @@ type StackGuard = new: maxDepth: int * name: string -> StackGuard /// Execute the new function, on a new thread if necessary - member Guard: f: (unit -> 'T) -> 'T + member Guard: + f: (unit -> 'T) * + [] memberName: string * + [] path: string * + [] line: int -> + 'T static member GetDepthOption: string -> int diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 5f1d9c3354f..ebc08633021 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -34,6 +34,12 @@ module internal Activity = let outputDllFile = "outputDllFile" let buildPhase = "buildPhase" let version = "version" + let stackGuardName = "stackGuardName" + let stackGuardCurrentDepth = "stackGuardCurrentDepth" + let stackGuardMaxDepth = "stackGuardMaxDepth" + let callerMemberName = "callerMemberName" + let callerFilePath = "callerFilePath" + let callerLineNumber = "callerLineNumber" let AllKnownTags = [| @@ -50,6 +56,12 @@ module internal Activity = gc2 outputDllFile buildPhase + stackGuardName + stackGuardCurrentDepth + stackGuardMaxDepth + callerMemberName + callerFilePath + callerLineNumber |] module Events = diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index afce0f3b554..ec6a9fbf6f8 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -29,6 +29,12 @@ module internal Activity = val cache: string val buildPhase: string val version: string + val stackGuardName: string + val stackGuardCurrentDepth: string + val stackGuardMaxDepth: string + val callerMemberName: string + val callerFilePath: string + val callerLineNumber: string module Events = val cacheHit: string