diff --git a/docs/large-inputs-and-stack-overflows.md b/docs/large-inputs-and-stack-overflows.md index 0f8dc53da9f..dc3d2adb5fb 100644 --- a/docs/large-inputs-and-stack-overflows.md +++ b/docs/large-inputs-and-stack-overflows.md @@ -21,6 +21,13 @@ The compiler performs constant folding for large constants so there are no costs Many sources of `StackOverflow` exceptions prior to F# 4.7 when processing these kinds of constructs were resolved by processing them on the heap via continuation passing techniques. This avoids filling data on the stack and appears to have negligible effects on overall throughout or memory usage of the compiler. +There are two techniques to deal with this + +1. Linearizing processing of specific input shapes, keeping stacks small +2. Using stack guards to simply temporarily move to a new thread when a certain threshold is reached. + +## Linearizing processing if certain inputs + Aside from array expressions, most of the previously-listed inputs are called "linear" expressions. This means that there is a single linear hole in the shape of expressions. For example: * `expr :: HOLE` (list expressions or other right-linear constructions) @@ -80,3 +87,31 @@ Some common aspects of this style of programming are: The previous example is considered incomplete, because arbitrary _combinations_ of `let` and sequential expressions aren't going to be dealt with in a tail-recursive way. The compiler generally tries to do these combinations as well. +## Stack Guards + +The `StackGuard` type is used to count synchronous recursive processing and move to a new thread if a limit is reached. Compilation globals are re-installed. Sample: + +```fsharp +let TcStackGuardDepth = StackGuard.GetDepthOption "Tc" + +... + stackGuard = StackGuard(TcMaxStackGuardDepth) + +let rec .... + +and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) = + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + + ... + +``` + +Note stack guarding doesn't result in a tailcall so will appear in recursive stack frames, because a counter must be decremented after the call. This is used systematically for recursive processing of: + +* SyntaxTree SynExpr +* TypedTree Expr + +We don't use it for other inputs. + diff --git a/src/fsharp/BuildGraph.fs b/src/fsharp/BuildGraph.fs index df797d0a3b3..36fe5e77ba6 100644 --- a/src/fsharp/BuildGraph.fs +++ b/src/fsharp/BuildGraph.fs @@ -10,22 +10,6 @@ open System.Globalization open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library -/// This represents the thread-local state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope(errorLogger: ErrorLogger, phase: BuildPhase) = - let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) - let unwindBP = PushThreadBuildPhaseUntilUnwind phase - - member _.ErrorLogger = errorLogger - member _.Phase = phase - - // Return the disposable object that cleans up - interface IDisposable with - member d.Dispose() = - unwindBP.Dispose() - unwindEL.Dispose() - [] type NodeCode<'T> = Node of Async<'T> @@ -89,7 +73,7 @@ type NodeCodeBuilder() = Node( async { CompileThreadStatic.ErrorLogger <- value.ErrorLogger - CompileThreadStatic.BuildPhase <- value.Phase + CompileThreadStatic.BuildPhase <- value.BuildPhase try return! binder value |> Async.AwaitNodeCode finally diff --git a/src/fsharp/BuildGraph.fsi b/src/fsharp/BuildGraph.fsi index cf1d750c3e0..39a5093a0fc 100644 --- a/src/fsharp/BuildGraph.fsi +++ b/src/fsharp/BuildGraph.fsi @@ -8,13 +8,6 @@ open System.Threading.Tasks open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library -/// This represents the global state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope = - new : ErrorLogger * BuildPhase -> CompilationGlobalsScope - interface IDisposable - /// Represents code that can be run as part of the build graph. /// /// This is essentially cancellable async code where the only asynchronous waits are on nodes. diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index ade713ea80f..1504b4e5222 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -760,6 +760,8 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter // translatedCtxt - represents the translation of the context in which the computation expression 'comp' occurs, up to a // hole to be filled by (part of) the results of translating 'comp'. let rec tryTrans firstTry q varSpace comp translatedCtxt = + // Guard the stack for deeply nested computation expressions + cenv.stackGuard.Guard <| fun () -> match comp with diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 1b9a15b2c6f..da4924d9937 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -42,6 +42,8 @@ open FSharp.Compiler.ExtensionTyping type cenv = TcFileState +let TcClassRewriteStackGuardDepth = StackGuard.GetDepthOption "TcClassRewrite" + //------------------------------------------------------------------------- // Mutually recursive shapes //------------------------------------------------------------------------- @@ -1144,8 +1146,8 @@ module IncrClassChecking = RewriteExpr { PreIntercept = Some FixupExprNode PostTransform = (fun _ -> None) PreInterceptBinding = None - IsUnderQuotations=true } expr - + RewriteQuotations = true + StackGuard = StackGuard(TcClassRewriteStackGuardDepth) } expr type IncrClassConstructionBindingsPhase2C = | Phase2CBindings of IncrClassBindingGroup list diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 3bf0cb89921..a3486d5394e 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -51,6 +51,12 @@ let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m) let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range) +#if DEBUG +let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 40 +#else +let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80 +#endif + //------------------------------------------------------------------------- // Errors. //------------------------------------------------------------------------- @@ -358,6 +364,9 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap + /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached + stackGuard: StackGuard + /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool @@ -421,6 +430,7 @@ type TcFileState = { g = g amap = amap recUses = ValMultiMap<_>.Empty + stackGuard = StackGuard(TcStackGuardDepth) createsGeneratedProvidedTypes = false topCcu = topCcu isScript = isScript @@ -5359,7 +5369,11 @@ and TcExprFlex2 cenv desiredTy env isMethodArg tpenv synExpr = TcExpr cenv (MustConvertTo (isMethodArg, desiredTy)) env tpenv synExpr and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) = - // Start an error recovery handler + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + + // Start an error recovery handler, and check for stack recursion depth, moving to a new stack if necessary. // Note the try/with can lead to tail-recursion problems for iterated constructs, e.g. let... in... // So be careful! try diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index b64b1dfc853..146be1dde99 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -10,6 +10,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -180,6 +181,9 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap + /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached + stackGuard: StackGuard + /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index d368392468a..810057e04f7 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -1655,7 +1655,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa os.Append(TargetInvocationExceptionWrapperE().Format e.Message) |> ignore #if DEBUG Printf.bprintf os "\nStack Trace\n%s\n" (e.ToString()) - if !showAssertForUnexpectedException then + if showAssertForUnexpectedException.Value then Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (e.ToString())) #endif diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index af0b8c6233a..bbbf217c21d 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -5,13 +5,16 @@ module internal FSharp.Compiler.Detuple open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler.TcGlobals +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.Xml + +let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite" // This pass has one aim. // - to eliminate tuples allocated at call sites (due to uncurried style) @@ -174,16 +177,23 @@ module GlobalUsageAnalysis = /// where first accessor in list applies first to the v/app. /// (b) log it's binding site representation. type Results = - { /// v -> context / APP inst args + { + /// v -> context / APP inst args Uses : Zmap + /// v -> binding repr Defns : Zmap + /// bound in a decision tree? - DecisionTreeBindings : Zset + DecisionTreeBindings: Zset + /// v -> v list * recursive? -- the others in the mutual binding - RecursiveBindings : Zmap - TopLevelBindings : Zset - IterationIsAtTopLevel : bool } + RecursiveBindings: Zmap + + TopLevelBindings: Zset + + IterationIsAtTopLevel: bool + } let z0 = { Uses = Zmap.empty valOrder @@ -841,10 +851,13 @@ let postTransformExpr (penv: penv) expr = | _ -> None let passImplFile penv assembly = - assembly |> RewriteImplFile { PreIntercept =None - PreInterceptBinding=None - PostTransform= postTransformExpr penv - IsUnderQuotations=false } + let rwenv = + { PreIntercept = None + PreInterceptBinding = None + PostTransform = postTransformExpr penv + RewriteQuotations = false + StackGuard = StackGuard(DetupleRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv //------------------------------------------------------------------------- // entry point diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 6757b628cf9..24b7c98b424 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -8,6 +8,9 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.Text open System open System.Diagnostics +open System.Threading +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras /// Represents the style being used to format errors [] @@ -433,33 +436,38 @@ module ErrorLoggerExtensions = /// NOTE: The change will be undone when the returned "unwind" object disposes let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = let oldBuildPhase = CompileThreadStatic.BuildPhaseUnchecked - CompileThreadStatic.BuildPhase <- phase - { new IDisposable with - member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase (* maybe null *) } + member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #ErrorLogger) = +let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) = let oldErrorLogger = CompileThreadStatic.ErrorLogger - let newErrorLogger = errorLoggerTransformer oldErrorLogger - let mutable newInstalled = true - let newIsInstalled() = if newInstalled then () else (assert false; (); (*failwith "error logger used after unwind"*)) // REVIEW: ok to throw? - let chkErrorLogger = { new ErrorLogger("PushErrorLoggerPhaseUntilUnwind") with - member _.DiagnosticSink(phasedError, isError) = newIsInstalled(); newErrorLogger.DiagnosticSink(phasedError, isError) - member _.ErrorCount = newIsInstalled(); newErrorLogger.ErrorCount } - - CompileThreadStatic.ErrorLogger <- chkErrorLogger - + CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger { new IDisposable with member _.Dispose() = - CompileThreadStatic.ErrorLogger <- oldErrorLogger - newInstalled <- false } + CompileThreadStatic.ErrorLogger <- oldErrorLogger } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger +/// This represents the thread-local state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = + let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase + + member _.ErrorLogger = errorLogger + member _.BuildPhase = buildPhase + + // Return the disposable object that cleans up + interface IDisposable with + member _.Dispose() = + unwindBP.Dispose() + unwindEL.Dispose() + // Global functions are still used by parser and TAST ops. /// Raises an exception with error recovery and returns unit. @@ -697,3 +705,36 @@ let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVer let featureStr = langVersion.GetFeatureString langFeature let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m)) + +/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached +type StackGuard(maxDepth: int) = + + let mutable depth = 1 + + member _.Guard(f) = + depth <- depth + 1 + try + if depth % maxDepth = 0 then + let errorLogger = CompileThreadStatic.ErrorLogger + let buildPhase = CompileThreadStatic.BuildPhase + async { + do! Async.SwitchToNewThread() + Thread.CurrentThread.Name <- "F# Extra Compilation Thread" + use _scope = new CompilationGlobalsScope(errorLogger, buildPhase) + return f() + } |> Async.RunImmediate + else + f() + finally + depth <- depth - 1 + + static member val DefaultDepth = +#if DEBUG + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50 +#else + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 100 +#endif + + static member GetDepthOption (name: string) = + GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth + diff --git a/src/fsharp/ErrorLogger.fsi b/src/fsharp/ErrorLogger.fsi index 97f4069ce84..06725175c1b 100644 --- a/src/fsharp/ErrorLogger.fsi +++ b/src/fsharp/ErrorLogger.fsi @@ -338,3 +338,24 @@ val checkLanguageFeatureErrorRecover: langVersion:LanguageVersion -> langFeature val tryLanguageFeatureErrorOption: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> exn option val languageFeatureNotSupportedInLibraryError: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> 'a + +type StackGuard = + new: maxDepth: int -> StackGuard + + /// Execute the new function, on a new thread if necessary + member Guard: f: (unit -> 'T) -> 'T + + static member GetDepthOption: string -> int + +/// This represents the global state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope = + new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + + interface IDisposable + + member ErrorLogger: ErrorLogger + + member BuildPhase: BuildPhase + diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 40618fb8139..fded9468d87 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -5,7 +5,9 @@ module internal FSharp.Compiler.FindUnsolved open Internal.Utilities.Collections open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -14,12 +16,15 @@ open FSharp.Compiler.TypeRelations type env = Nix +let FindUnsolvedStackGuardDepth = StackGuard.GetDepthOption "FindUnsolved" + /// The environment and collector type cenv = { g: TcGlobals amap: Import.ImportMap denv: DisplayEnv - mutable unsolved: Typars } + mutable unsolved: Typars + stackGuard: StackGuard } override x.ToString() = "" @@ -34,7 +39,9 @@ let accTypeInst cenv env tyargs = tyargs |> List.iter (accTy cenv env) /// Walk expressions, collecting type variables -let rec accExpr (cenv:cenv) (env:env) expr = +let rec accExpr (cenv:cenv) (env:env) expr = + cenv.stackGuard.Guard <| fun () -> + let expr = stripExpr expr match expr with | Expr.Sequential (e1, e2, _, _, _) -> @@ -278,7 +285,8 @@ let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) = { g =g amap=amap denv=denv - unsolved = [] } + unsolved = [] + stackGuard = StackGuard(FindUnsolvedStackGuardDepth) } accModuleOrNamespaceDef cenv Nix mdef accAttribs cenv Nix extraAttribs List.rev cenv.unsolved diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 98e51366088..3f808c15099 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -40,6 +40,8 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypeRelations +let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen" + let IsNonErasedTypar (tp: Typar) = not tp.IsErased @@ -255,14 +257,12 @@ type cenv = /// Used to apply forced inlining optimizations to witnesses generated late during codegen mutable optimizeDuringCodeGen: bool -> Expr -> Expr - /// What depth are we at when generating an expression? - mutable exprRecursionDepth: int + /// Guard the stack and move to a new one if necessary + mutable stackGuard: StackGuard - /// Delayed Method Generation - prevents stack overflows when we need to generate methods that are split into many methods by the optimizer. - delayedGenMethods: Queue unit> } - override x.ToString() = "" + override _.ToString() = "" let mkTypeOfExpr cenv m ilty = @@ -2479,32 +2479,9 @@ let ProcessDebugPointForExpr (cenv: cenv) (cgbuf: CodeGenBuffer) sp expr = //------------------------------------------------------------------------- let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel = - cenv.exprRecursionDepth <- cenv.exprRecursionDepth + 1 - - if cenv.exprRecursionDepth > 1 then - StackGuard.EnsureSufficientExecutionStack cenv.exprRecursionDepth - GenExprAux cenv cgbuf eenv sp expr sequel - else - GenExprWithStackGuard cenv cgbuf eenv sp expr sequel - - cenv.exprRecursionDepth <- cenv.exprRecursionDepth - 1 - - if cenv.exprRecursionDepth = 0 then - ProcessDelayedGenMethods cenv + cenv.stackGuard.Guard <| fun () -> -and ProcessDelayedGenMethods cenv = - while cenv.delayedGenMethods.Count > 0 do - let gen = cenv.delayedGenMethods.Dequeue () - gen cenv - -and GenExprWithStackGuard cenv cgbuf eenv sp expr sequel = - assert (cenv.exprRecursionDepth = 1) - try - GenExprAux cenv cgbuf eenv sp expr sequel - assert (cenv.exprRecursionDepth = 1) - with - | :? System.InsufficientExecutionStackException -> - error(InternalError(sprintf "Expression is too large and/or complex to emit. Method name: '%s'. Recursive depth: %i." cgbuf.MethodName cenv.exprRecursionDepth, expr.Range)) + GenExprAux cenv cgbuf eenv sp expr sequel /// Process the debug point and check for alternative ways to generate this expression. /// Returns 'true' if the expression was processed by alternative means. @@ -5355,7 +5332,7 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN NestedTypeRefForCompLoc eenvouter.cloc cloName // Collect the free variables of the closure - let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr + let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr // Partition the free variables when some can be accessed from places besides the immediate environment // Also filter out the current value being bound, if any, as it is available from the "this" @@ -6842,20 +6819,10 @@ and GenMethodForBinding | [h] -> Some h | _ -> None - let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel) + let ilCodeLazy = CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel) // This is the main code generation for most methods - false, MethodBody.IL(ilCodeLazy), false - - match ilMethodBody with - | MethodBody.IL(ilCodeLazy) -> - if cenv.exprRecursionDepth > 0 then - cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore) - else - // Eagerly codegen if we are not in an expression depth. - ilCodeLazy.Force() |> ignore - | _ -> - () + false, MethodBody.IL(notlazy ilCodeLazy), false // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke let attrs = @@ -8897,8 +8864,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai intraAssemblyInfo = intraAssemblyInfo opts = codeGenOpts optimizeDuringCodeGen = (fun _flag expr -> expr) - exprRecursionDepth = 0 - delayedGenMethods = Queue () } + stackGuard = StackGuard(IlxGenStackGuardDepth) } GenerateCode (cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs) /// Invert the compilation of the given value and clear the storage of the value diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 2388de90d9f..9536978c39a 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -22,6 +22,8 @@ open FSharp.Compiler.TcGlobals let verboseTLR = false +let InnerLambdasToTopLevelFunctionsStackGuardDepth = StackGuard.GetDepthOption "InnerLambdasToTopLevelFunctions" + //------------------------------------------------------------------------- // library helpers //------------------------------------------------------------------------- @@ -482,7 +484,9 @@ module Pass2_DetermineReqdItems = if verboseTLR then dprintf "shortCall: not-rec: %s\n" gv.LogicalName state - let FreeInBindings bs = List.fold (foldOn (freeInBindingRhs CollectTyparsAndLocals) unionFreeVars) emptyFreeVars bs + let FreeInBindings bs = + let opts = CollectTyparsAndLocalsWithStackGuard() + List.fold (foldOn (freeInBindingRhs opts) unionFreeVars) emptyFreeVars bs /// Intercepts selected exprs. /// "letrec f1, f2, ... = fBody1, fBody2, ... in rest" - @@ -877,6 +881,7 @@ module Pass4_RewriteAssembly = type RewriteContext = { ccu: CcuThunk g: TcGlobals + stackGuard: StackGuard tlrS: Zset topValS: Zset arityM: Zmap @@ -1098,6 +1103,7 @@ module Pass4_RewriteAssembly = /// At free vals, fixup 0-call if it is an arity-met constant. /// Other cases rewrite structurally. let rec TransExpr (penv: RewriteContext) (z: RewriteState) expr: Expr * RewriteState = + penv.stackGuard.Guard <| fun () -> match expr with // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms @@ -1128,7 +1134,7 @@ module Pass4_RewriteAssembly = // reclink - suppress | Expr.Link r -> - TransExpr penv z (!r) + TransExpr penv z r.Value // ilobj - has implicit lambda exprs and recursive/base references | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> @@ -1177,7 +1183,7 @@ module Pass4_RewriteAssembly = (typeDefs,argTypes,argExprs,data), z let data, z = - match !dataCell with + match dataCell.Value with | Some (data1, data2) -> let data1, z = doData data1 z let data2, z = doData data2 z @@ -1374,7 +1380,16 @@ let MakeTopLevelRepresentationDecisions ccu g expr = if verboseTLR then dprintf "TransExpr(rw)------\n" let expr, _ = let penv: Pass4_RewriteAssembly.RewriteContext = - {ccu=ccu; g=g; tlrS=tlrS; topValS=topValS; arityM=arityM; fclassM=fclassM; recShortCallS=recShortCallS; envPackM=envPackM; fHatM=fHatM} + { ccu = ccu + g = g + tlrS = tlrS + topValS = topValS + arityM = arityM + fclassM = fclassM + recShortCallS = recShortCallS + envPackM = envPackM + fHatM = fHatM + stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth) } let z = Pass4_RewriteAssembly.rewriteState0 Pass4_RewriteAssembly.TransImplFile penv z expr diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index ec6a327b6e3..c8c19cbe03e 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -18,6 +18,8 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite" + //---------------------------------------------------------------------------- // Eta-expansion of calls to top-level-methods @@ -53,10 +55,13 @@ let InterceptExpr g cont expr = /// any known arguments. The results are later optimized by the peephole /// optimizer in opt.fs let LowerImplFile g assembly = - RewriteImplFile { PreIntercept = Some(InterceptExpr g) - PreInterceptBinding=None - PostTransform= (fun _ -> None) - IsUnderQuotations=false } assembly + let rwenv = + { PreIntercept = Some(InterceptExpr g) + PreInterceptBinding=None + PostTransform= (fun _ -> None) + RewriteQuotations=false + StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv //---------------------------------------------------------------------------- // General helpers diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index c0d4986f168..332326f23ca 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -6,6 +6,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -13,6 +14,8 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50 + let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e type StateMachineConversionFirstPhaseResult = @@ -354,7 +357,8 @@ type LowerStateMachine(g: TcGlobals) = { PreIntercept = Some (fun cont e -> match TryReduceExpr env e [] id with Some e2 -> Some (cont e2) | None -> None) PostTransform = (fun _ -> None) PreInterceptBinding = None - IsUnderQuotations=true } + RewriteQuotations=true + StackGuard = StackGuard(LowerStateMachineStackGuardDepth) } let ConvertStateMachineLeafExpression (env: env) expr = if sm_verbose then printfn "ConvertStateMachineLeafExpression for %A..." expr diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 72266c6bf1f..0b88e9c2c3b 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -34,6 +34,8 @@ open FSharp.Compiler.TypeRelations open System.Collections.Generic open System.Collections.ObjectModel +let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50 + #if DEBUG let verboseOptimizationInfo = try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false @@ -428,6 +430,8 @@ type cenv = /// cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType casApplied: Dictionary + stackGuard: StackGuard + } override x.ToString() = "" @@ -1198,7 +1202,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = // Check for escape in lambda | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when - (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr + (let fvs = freeInExpr (if isNil boundTyVars then (CollectLocalsWithStackGuard()) else CollectTyparsAndLocals) expr (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || fvs.UsesMethodLocalConstructs) -> @@ -1459,7 +1463,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = let IsUniqueUse vspec2 args = valEq vspec1 vspec2 // REVIEW: this looks slow. Look only for one variable instead - && (let fvs = accFreeInExprs CollectLocals args emptyFreeVars + && (let fvs = accFreeInExprs (CollectLocalsWithStackGuard()) args emptyFreeVars not (Zset.contains vspec1 fvs.FreeLocals)) // Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation @@ -2009,6 +2013,7 @@ let IsILMethodRefSystemStringConcatArray (mref: ILMethodRef) = /// Optimize/analyze an expression let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = + cenv.stackGuard.Guard <| fun () -> // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need // complete inference types. @@ -2540,7 +2545,7 @@ and OptimizeLinearExpr cenv env expr contf = OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. // Is it quadratic or quasi-quadratic? - if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals bodyR).FreeLocals) (bindR, bindingInfo) then + if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr (CollectLocalsWithStackGuard()) bodyR).FreeLocals) (bindR, bindingInfo) then // Eliminate let bindings on the way back up let exprR, adjust = TryEliminateLet cenv env bindR bodyR m exprR, @@ -3492,7 +3497,7 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e: Expr, einfo) = // We can only split an expression out as a method if certain conditions are met. // It can't use any protected or base calls, rethrow(), byrefs etc. let m = e.Range - (let fvs = freeInExpr CollectLocals e + (let fvs = freeInExpr (CollectLocalsWithStackGuard()) e not fvs.UsesUnboundRethrow && not fvs.UsesMethodLocalConstructs && fvs.FreeLocals |> Zset.forall (fun v -> @@ -3761,7 +3766,7 @@ and OptimizeModuleExpr cenv env x = let def = if not cenv.settings.LocalOptimizationsEnabled then def else - let fvs = freeInModuleOrNamespace CollectLocals def + let fvs = freeInModuleOrNamespace (CollectLocalsWithStackGuard()) def let dead = bindInfosColl |> List.filter (fun (bind, binfo) -> @@ -3919,6 +3924,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr localInternalVals=Dictionary(10000) emitTailcalls=emitTailcalls casApplied=Dictionary() + stackGuard = StackGuard(OptimizerStackGuardDepth) } let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index dd3bcb7fc65..21f98a518f4 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -60,7 +60,7 @@ open FSharp.Compiler.TypeRelations // b) a lambda expression - rejected. // c) none of the above - rejected as when checking outmost expressions. - +let PostInferenceChecksStackGuardDepth = GetEnvInteger "FSHARP_PostInferenceChecks" 50 //-------------------------------------------------------------------------- // check environment @@ -208,6 +208,8 @@ type cenv = mutable anonRecdTypes: StampMap + stackGuard: StackGuard + g: TcGlobals amap: Import.ImportMap @@ -453,7 +455,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit (v.IsBaseVal || isByrefLikeTy cenv.g m v.Type) && not (ListSet.contains valEq v syntacticArgs) - let frees = freeInExpr CollectLocals body + let frees = freeInExpr (CollectLocalsWithStackGuard()) body let fvs = frees.FreeLocals if not allowProtected && frees.UsesMethodLocalConstructs then @@ -1091,6 +1093,10 @@ and TryCheckResumableCodeConstructs cenv env expr : bool = /// Check an expression, given information about the position of the expression and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limit = + + // Guard the stack for deeply nested expressions + cenv.stackGuard.Guard <| fun () -> + let g = cenv.g let origExpr = stripExpr origExpr @@ -2579,22 +2585,23 @@ and CheckModuleSpec cenv env x = let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, tcValF, denv, mexpr, extraAttribs, isLastCompiland: bool*bool, isInternalTestSpanStackReferring) = let cenv = - { g =g - reportErrors=reportErrors + { g = g + reportErrors = reportErrors boundVals = Dictionary<_, _>(100, HashIdentity.Structural) limitVals = Dictionary<_, _>(100, HashIdentity.Structural) - potentialUnboundUsesOfVals=Map.empty + stackGuard = StackGuard(PostInferenceChecksStackGuardDepth) + potentialUnboundUsesOfVals = Map.empty anonRecdTypes = StampMap.Empty - usesQuotations=false - infoReader=infoReader - internalsVisibleToPaths=internalsVisibleToPaths - amap=amap - denv=denv - viewCcu= viewCcu - isLastCompiland=isLastCompiland + usesQuotations = false + infoReader = infoReader + internalsVisibleToPaths = internalsVisibleToPaths + amap = amap + denv = denv + viewCcu = viewCcu + isLastCompiland = isLastCompiland isInternalTestSpanStackReferring = isInternalTestSpanStackReferring tcVal = tcValF - entryPointGiven=false} + entryPointGiven = false} // Certain type equality checks go faster if these TyconRefs are pre-resolved. // This is because pre-resolving allows tycon equality to be determined by pointer equality on the entities. diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 97171eecb17..1dedf910ac6 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -32,6 +32,10 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.ExtensionTyping #endif +let AccFreeVarsStackGuardDepth = GetEnvInteger "FSHARP_AccFreeVars" 100 +let RemapExprStackGuardDepth = GetEnvInteger "FSHARP_RemapExpr" 50 +let FoldExprStackGuardDepth = GetEnvInteger "FSHARP_FoldExpr" 50 + //--------------------------------------------------------------------------- // Basic data structures //--------------------------------------------------------------------------- @@ -365,9 +369,9 @@ let remapTypes tyenv x = remapTypesAux tyenv x /// Use this one for any type that may be a forall type where the type variables may contain attributes -/// Logically speaking this is mutually recursive with remapAttrib defined much later in this file, +/// Logically speaking this is mutually recursive with remapAttribImpl defined much later in this file, /// because types may contain forall types that contain attributes, which need to be remapped. -/// We currently break the recursion by passing in remapAttrib as a function parameter. +/// We currently break the recursion by passing in remapAttribImpl as a function parameter. /// Use this one for any type that may be a forall type where the type variables may contain attributes let remapTypeFull remapAttrib tyenv ty = if isRemapEmpty tyenv then ty else @@ -1999,7 +2003,8 @@ type FreeVarOptions = includeLocalTyconReprs: bool includeRecdFields: bool includeUnionCases: bool - includeLocals: bool } + includeLocals: bool + stackGuard: StackGuard option } let CollectAllNoCaching = { canCache = false @@ -2009,7 +2014,8 @@ let CollectAllNoCaching = includeRecdFields = true includeUnionCases = true includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None} let CollectTyparsNoCaching = { canCache = false @@ -2019,7 +2025,8 @@ let CollectTyparsNoCaching = includeLocalTyconReprs = false includeRecdFields = false includeUnionCases = false - includeLocals = false } + includeLocals = false + stackGuard = None } let CollectLocalsNoCaching = { canCache = false @@ -2029,7 +2036,8 @@ let CollectLocalsNoCaching = includeLocalTyconReprs = false includeRecdFields = false includeUnionCases = false - includeLocals = true } + includeLocals = true + stackGuard = None } let CollectTyparsAndLocalsNoCaching = { canCache = false @@ -2039,7 +2047,8 @@ let CollectTyparsAndLocalsNoCaching = includeRecdFields = false includeUnionCases = false includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None } let CollectAll = { canCache = false @@ -2049,9 +2058,10 @@ let CollectAll = includeRecdFields = true includeUnionCases = true includeTypars = true - includeLocals = true } + includeLocals = true + stackGuard = None } -let CollectTyparsAndLocals = // CollectAll +let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll { canCache = true // only cache for this one collectInTypes = true includeTypars = true @@ -2059,13 +2069,21 @@ let CollectTyparsAndLocals = // CollectAll includeLocalTycons = false includeLocalTyconReprs = false includeRecdFields = false - includeUnionCases = false } + includeUnionCases = false + stackGuard = stackGuardOpt } +let CollectTyparsAndLocals = CollectTyparsAndLocalsImpl None + let CollectTypars = CollectTyparsAndLocals let CollectLocals = CollectTyparsAndLocals +let CollectTyparsAndLocalsWithStackGuard() = + let stackGuard = StackGuard(AccFreeVarsStackGuardDepth) + CollectTyparsAndLocalsImpl (Some stackGuard) + +let CollectLocalsWithStackGuard() = CollectTyparsAndLocalsWithStackGuard() let accFreeLocalTycon opts x acc = if not opts.includeLocalTycons then acc else @@ -4714,8 +4732,14 @@ and accFreeInExprLinear (opts: FreeVarOptions) x acc contf = contf (accFreeInExpr opts x acc) and accFreeInExprNonLinear opts x acc = - match x with + + match opts.stackGuard with + | None -> accFreeInExprNonLinearImpl opts x acc + | Some stackGuard -> stackGuard.Guard (fun () -> accFreeInExprNonLinearImpl opts x acc) +and accFreeInExprNonLinearImpl opts x acc = + + match x with // BINDING CONSTRUCTS | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, bodyExpr, _, rty) -> unionFreeVars @@ -5165,36 +5189,42 @@ let tmenvCopyRemapAndBindTypars remapAttrib tmenv tps = let tmenvinner = tyenvinner tps', tmenvinner -let rec remapAttrib g tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, targets, m)) = +type RemapContext = + { g: TcGlobals + stackGuard: StackGuard } + +let rec remapAttribImpl ctxt tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, targets, m)) = Attrib(remapTyconRef tmenv.tyconRefRemap tcref, remapAttribKind tmenv kind, - args |> List.map (remapAttribExpr g tmenv), - props |> List.map (fun (AttribNamedArg(nm, ty, flg, expr)) -> AttribNamedArg(nm, remapType tmenv ty, flg, remapAttribExpr g tmenv expr)), + args |> List.map (remapAttribExpr ctxt tmenv), + props |> List.map (fun (AttribNamedArg(nm, ty, flg, expr)) -> AttribNamedArg(nm, remapType tmenv ty, flg, remapAttribExpr ctxt tmenv expr)), isGetOrSetAttr, targets, m) -and remapAttribExpr g tmenv (AttribExpr(e1, e2)) = - AttribExpr(remapExpr g CloneAll tmenv e1, remapExpr g CloneAll tmenv e2) +and remapAttribExpr ctxt tmenv (AttribExpr(e1, e2)) = + AttribExpr(remapExprImpl ctxt CloneAll tmenv e1, remapExprImpl ctxt CloneAll tmenv e2) -and remapAttribs g tmenv xs = List.map (remapAttrib g tmenv) xs +and remapAttribs ctxt tmenv xs = + List.map (remapAttribImpl ctxt tmenv) xs -and remapPossibleForallTy g tmenv ty = remapTypeFull (remapAttribs g tmenv) tmenv ty +and remapPossibleForallTyImpl ctxt tmenv ty = + remapTypeFull (remapAttribs ctxt tmenv) tmenv ty -and remapArgData g tmenv (argInfo: ArgReprInfo) : ArgReprInfo = - { Attribs = remapAttribs g tmenv argInfo.Attribs; Name = argInfo.Name } +and remapArgData ctxt tmenv (argInfo: ArgReprInfo) : ArgReprInfo = + { Attribs = remapAttribs ctxt tmenv argInfo.Attribs; Name = argInfo.Name } -and remapValReprInfo g tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = - ValReprInfo(tpNames, List.mapSquared (remapArgData g tmenv) arginfosl, remapArgData g tmenv retInfo) +and remapValReprInfo ctxt tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = + ValReprInfo(tpNames, List.mapSquared (remapArgData ctxt tmenv) arginfosl, remapArgData ctxt tmenv retInfo) -and remapValData g tmenv (d: ValData) = +and remapValData ctxt tmenv (d: ValData) = let ty = d.val_type let topValInfo = d.ValReprInfo - let tyR = ty |> remapPossibleForallTy g tmenv + let tyR = ty |> remapPossibleForallTyImpl ctxt tmenv let declaringEntityR = d.DeclaringEntity |> remapParentRef tmenv - let reprInfoR = d.ValReprInfo |> Option.map (remapValReprInfo g tmenv) - let memberInfoR = d.MemberInfo |> Option.map (remapMemberInfo g d.val_range topValInfo ty tyR tmenv) - let attribsR = d.Attribs |> remapAttribs g tmenv + let reprInfoR = d.ValReprInfo |> Option.map (remapValReprInfo ctxt tmenv) + let memberInfoR = d.MemberInfo |> Option.map (remapMemberInfo ctxt d.val_range topValInfo ty tyR tmenv) + let attribsR = d.Attribs |> remapAttribs ctxt tmenv { d with val_type = tyR val_opt_data = @@ -5222,28 +5252,32 @@ and copyVal compgen (v: Val) = | OnlyCloneExprVals when v.IsMemberOrModuleBinding -> v | _ -> v |> Construct.NewModifiedVal id -and fixupValData g compgen tmenv (v2: Val) = +and fixupValData ctxt compgen tmenv (v2: Val) = // only fixup if we copy the value match compgen with | OnlyCloneExprVals when v2.IsMemberOrModuleBinding -> () | _ -> - let newData = remapValData g tmenv v2 |> markAsCompGen compgen + let newData = remapValData ctxt tmenv v2 |> markAsCompGen compgen // uses the same stamp v2.SetData newData -and copyAndRemapAndBindVals g compgen tmenv vs = +and copyAndRemapAndBindVals ctxt compgen tmenv vs = let vs2 = vs |> List.map (copyVal compgen) let tmenvinner = bindLocalVals vs vs2 tmenv - vs2 |> List.iter (fixupValData g compgen tmenvinner) + vs2 |> List.iter (fixupValData ctxt compgen tmenvinner) vs2, tmenvinner -and copyAndRemapAndBindVal g compgen tmenv v = +and copyAndRemapAndBindVal ctxt compgen tmenv v = let v2 = v |> copyVal compgen let tmenvinner = bindLocalVal v v2 tmenv - fixupValData g compgen tmenvinner v2 + fixupValData ctxt compgen tmenvinner v2 v2, tmenvinner -and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = +and remapExprImpl (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) expr = + + // Guard against stack overflow, moving to a whole new stack if necessary + ctxt.stackGuard.Guard <| fun () -> + match expr with // Handle the linear cases for arbitrary-sized inputs @@ -5251,27 +5285,27 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | LinearMatchExpr _ | Expr.Sequential _ | Expr.Let _ -> - remapLinearExpr g compgen tmenv expr (fun x -> x) + remapLinearExpr ctxt compgen tmenv expr (fun x -> x) // Binding constructs - see also dtrees below | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> - remapLambaExpr g compgen tmenv (ctorThisValOpt, baseValOpt, vs, b, m, rty) + remapLambaExpr ctxt compgen tmenv (ctorThisValOpt, baseValOpt, vs, b, m, rty) | Expr.TyLambda (_, tps, b, m, rty) -> - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - mkTypeLambda m tps' (remapExpr g compgen tmenvinner b, remapType tmenvinner rty) + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + mkTypeLambda m tps' (remapExprImpl ctxt compgen tmenvinner b, remapType tmenvinner rty) | Expr.TyChoose (tps, b, m) -> - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - Expr.TyChoose (tps', remapExpr g compgen tmenvinner b, m) + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + Expr.TyChoose (tps', remapExprImpl ctxt compgen tmenvinner b, m) | Expr.LetRec (binds, e, m, _) -> - let binds', tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds - Expr.LetRec (binds', remapExpr g compgen tmenvinner e, m, Construct.NewFreeVarsCache()) + let binds', tmenvinner = copyAndRemapAndBindBindings ctxt compgen tmenv binds + Expr.LetRec (binds', remapExprImpl ctxt compgen tmenvinner e, m, Construct.NewFreeVarsCache()) | Expr.Match (spBind, exprm, pt, targets, m, ty) -> - primMkMatch (spBind, exprm, remapDecisionTree g compgen tmenv pt, - targets |> Array.map (remapTarget g compgen tmenv), + primMkMatch (spBind, exprm, remapDecisionTree ctxt compgen tmenv pt, + targets |> Array.map (remapTarget ctxt compgen tmenv), m, remapType tmenv ty) | Expr.Val (vr, vf, m) -> @@ -5281,14 +5315,14 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = else Expr.Val (vr', vf', m) | Expr.Quote (a, dataCell, isFromQueryExpression, m, ty) -> - remapQuoteExpr g compgen tmenv (a, dataCell, isFromQueryExpression, m, ty) + remapQuoteExpr ctxt compgen tmenv (a, dataCell, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> - let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev + let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv basev mkObjExpr (remapType tmenv ty, basev', - remapExpr g compgen tmenv basecall, - List.map (remapMethod g compgen tmenvinner) overrides, - List.map (remapInterfaceImpl g compgen tmenvinner) iimpls, m) + remapExprImpl ctxt compgen tmenv basecall, + List.map (remapMethod ctxt compgen tmenvinner) overrides, + List.map (remapInterfaceImpl ctxt compgen tmenvinner) iimpls, m) // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdFieldRef below. // This is "ok", in the sense that it is always valid to fix these up to be uses @@ -5297,34 +5331,34 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = | Expr.Op (TOp.ValFieldGetAddr (rfref, readonly), tinst, [arg], m) when not rfref.RecdField.IsMutable && - not (entityRefInThisAssembly g.compilingFslib rfref.TyconRef) -> + not (entityRefInThisAssembly ctxt.g.compilingFslib rfref.TyconRef) -> let tinst = remapTypes tmenv tinst - let arg = remapExpr g compgen tmenv arg + let arg = remapExprImpl ctxt compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr (arg, rfref, tinst, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (TOp.UnionCaseFieldGetAddr (uref, cidx, readonly), tinst, [arg], m) when not (uref.FieldByIndex(cidx).IsMutable) && - not (entityRefInThisAssembly g.compilingFslib uref.TyconRef) -> + not (entityRefInThisAssembly ctxt.g.compilingFslib uref.TyconRef) -> let tinst = remapTypes tmenv tinst - let arg = remapExpr g compgen tmenv arg + let arg = remapExprImpl ctxt compgen tmenv arg let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr (arg, uref, tinst, cidx, m)) (mkValAddr m readonly (mkLocalValRef tmp)) | Expr.Op (op, tinst, args, m) -> - remapOpExpr g compgen tmenv (op, tinst, args, m) expr + remapOpExpr ctxt compgen tmenv (op, tinst, args, m) expr | Expr.App (e1, e1ty, tyargs, args, m) -> - remapAppExpr g compgen tmenv (e1, e1ty, tyargs, args, m) expr + remapAppExpr ctxt compgen tmenv (e1, e1ty, tyargs, args, m) expr | Expr.Link eref -> - remapExpr g compgen tmenv eref.Value + remapExprImpl ctxt compgen tmenv eref.Value | Expr.StaticOptimization (cs, e2, e3, m) -> // note that type instantiation typically resolve the static constraints here - mkStaticOptimizationExpr g (List.map (remapConstraint tmenv) cs, remapExpr g compgen tmenv e2, remapExpr g compgen tmenv e3, m) + mkStaticOptimizationExpr ctxt.g (List.map (remapConstraint tmenv) cs, remapExprImpl ctxt compgen tmenv e2, remapExprImpl ctxt compgen tmenv e3, m) | Expr.Const (c, m, ty) -> let ty' = remapType tmenv ty @@ -5334,78 +5368,78 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let traitInfoR = remapTraitInfo tmenv traitInfo Expr.WitnessArg (traitInfoR, m) -and remapLambaExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (ctorThisValOpt, baseValOpt, vs, b, m, rty) = - let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt - let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv baseValOpt - let vs, tmenv = copyAndRemapAndBindVals g compgen tmenv vs - let b = remapExpr g compgen tmenv b +and remapLambaExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (ctorThisValOpt, baseValOpt, vs, b, m, rty) = + let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv ctorThisValOpt + let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal ctxt compgen) tmenv baseValOpt + let vs, tmenv = copyAndRemapAndBindVals ctxt compgen tmenv vs + let b = remapExprImpl ctxt compgen tmenv b let rty = remapType tmenv rty Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) -and remapQuoteExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (a, dataCell, isFromQueryExpression, m, ty) = - let doData (typeDefs, argTypes, argExprs, res) = (typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, res) +and remapQuoteExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (a, dataCell, isFromQueryExpression, m, ty) = + let doData (typeDefs, argTypes, argExprs, res) = (typeDefs, remapTypesAux tmenv argTypes, remapExprs ctxt compgen tmenv argExprs, res) let data' = match dataCell.Value with | None -> None | Some (data1, data2) -> Some (doData data1, doData data2) // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen - Expr.Quote (remapExpr g compgen tmenv a, ref data', isFromQueryExpression, m, remapType tmenv ty) + Expr.Quote (remapExprImpl ctxt compgen tmenv a, ref data', isFromQueryExpression, m, remapType tmenv ty) -and remapOpExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (op, tinst, args, m) origExpr = +and remapOpExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (op, tinst, args, m) origExpr = let op' = remapOp tmenv op let tinst' = remapTypes tmenv tinst - let args' = remapExprs g compgen tmenv args + let args' = remapExprs ctxt compgen tmenv args if op === op' && tinst === tinst' && args === args' then origExpr else Expr.Op (op', tinst', args', m) -and remapAppExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) (e1, e1ty, tyargs, args, m) origExpr = - let e1' = remapExpr g compgen tmenv e1 - let e1ty' = remapPossibleForallTy g tmenv e1ty +and remapAppExpr (ctxt: RemapContext) (compgen: ValCopyFlag) (tmenv: Remap) (e1, e1ty, tyargs, args, m) origExpr = + let e1' = remapExprImpl ctxt compgen tmenv e1 + let e1ty' = remapPossibleForallTyImpl ctxt tmenv e1ty let tyargs' = remapTypes tmenv tyargs - let args' = remapExprs g compgen tmenv args + let args' = remapExprs ctxt compgen tmenv args if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then origExpr else Expr.App (e1', e1ty', tyargs', args', m) -and remapTarget g compgen tmenv (TTarget(vs, e, spTarget, flags)) = - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs - TTarget(vs', remapExpr g compgen tmenvinner e, spTarget, flags) +and remapTarget ctxt compgen tmenv (TTarget(vs, e, spTarget, flags)) = + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenv vs + TTarget(vs', remapExprImpl ctxt compgen tmenvinner e, spTarget, flags) -and remapLinearExpr g compgen tmenv expr contf = +and remapLinearExpr ctxt compgen tmenv expr contf = match expr with | Expr.Let (bind, bodyExpr, m, _) -> - let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind + let bind', tmenvinner = copyAndRemapAndBindBinding ctxt compgen tmenv bind // tailcall for the linear position - remapLinearExpr g compgen tmenvinner bodyExpr (contf << mkLetBind m bind') + remapLinearExpr ctxt compgen tmenvinner bodyExpr (contf << mkLetBind m bind') | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> - let expr1' = remapExpr g compgen tmenv expr1 + let expr1' = remapExprImpl ctxt compgen tmenv expr1 // tailcall for the linear position - remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + remapLinearExpr ctxt compgen tmenv expr2 (contf << (fun expr2' -> if expr1 === expr1' && expr2 === expr2' then expr else Expr.Sequential (expr1', expr2', dir, spSeq, m))) | LinearMatchExpr (spBind, exprm, dtree, tg1, expr2, sp2, m2, ty) -> - let dtree' = remapDecisionTree g compgen tmenv dtree - let tg1' = remapTarget g compgen tmenv tg1 + let dtree' = remapDecisionTree ctxt compgen tmenv dtree + let tg1' = remapTarget ctxt compgen tmenv tg1 let ty' = remapType tmenv ty // tailcall for the linear position - remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + remapLinearExpr ctxt compgen tmenv expr2 (contf << (fun expr2' -> rebuildLinearMatchExpr (spBind, exprm, dtree', tg1', expr2', sp2, m2, ty'))) | LinearOpExpr (op, tyargs, argsFront, argLast, m) -> let op' = remapOp tmenv op let tinst' = remapTypes tmenv tyargs - let argsFront' = remapExprs g compgen tmenv argsFront + let argsFront' = remapExprs ctxt compgen tmenv argsFront // tailcall for the linear position - remapLinearExpr g compgen tmenv argLast (contf << (fun argLast' -> + remapLinearExpr ctxt compgen tmenv argLast (contf << (fun argLast' -> if op === op' && tyargs === tinst' && argsFront === argsFront' && argLast === argLast' then expr else rebuildLinearOpExpr (op', tinst', argsFront', argLast', m))) | _ -> - contf (remapExpr g compgen tmenv expr) + contf (remapExprImpl ctxt compgen tmenv expr) and remapConstraint tyenv c = match c with @@ -5444,14 +5478,14 @@ and remapValFlags tmenv x = | PossibleConstrainedCall ty -> PossibleConstrainedCall (remapType tmenv ty) | _ -> x -and remapExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es +and remapExprs ctxt compgen tmenv es = List.mapq (remapExprImpl ctxt compgen tmenv) es -and remapFlatExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es +and remapFlatExprs ctxt compgen tmenv es = List.mapq (remapExprImpl ctxt compgen tmenv) es -and remapDecisionTree g compgen tmenv x = +and remapDecisionTree ctxt compgen tmenv x = match x with | TDSwitch(sp, e1, cases, dflt, m) -> - let e1R = remapExpr g compgen tmenv e1 + let e1R = remapExprImpl ctxt compgen tmenv e1 let casesR = cases |> List.map (fun (TCase(test, subTree)) -> let testR = @@ -5463,81 +5497,81 @@ and remapDecisionTree g compgen tmenv x = | DecisionTreeTest.IsNull -> DecisionTreeTest.IsNull | DecisionTreeTest.ActivePatternCase _ -> failwith "DecisionTreeTest.ActivePatternCase should only be used during pattern match compilation" | DecisionTreeTest.Error(m) -> DecisionTreeTest.Error(m) - let subTreeR = remapDecisionTree g compgen tmenv subTree + let subTreeR = remapDecisionTree ctxt compgen tmenv subTree TCase(testR, subTreeR)) - let dfltR = Option.map (remapDecisionTree g compgen tmenv) dflt + let dfltR = Option.map (remapDecisionTree ctxt compgen tmenv) dflt TDSwitch(sp, e1R, casesR, dfltR, m) | TDSuccess (es, n) -> - TDSuccess (remapFlatExprs g compgen tmenv es, n) + TDSuccess (remapFlatExprs ctxt compgen tmenv es, n) | TDBind (bind, rest) -> - let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind - TDBind (bind', remapDecisionTree g compgen tmenvinner rest) + let bind', tmenvinner = copyAndRemapAndBindBinding ctxt compgen tmenv bind + TDBind (bind', remapDecisionTree ctxt compgen tmenvinner rest) -and copyAndRemapAndBindBinding g compgen tmenv (bind: Binding) = +and copyAndRemapAndBindBinding ctxt compgen tmenv (bind: Binding) = let v = bind.Var - let v', tmenv = copyAndRemapAndBindVal g compgen tmenv v - remapAndRenameBind g compgen tmenv bind v', tmenv - -and copyAndRemapAndBindBindings g compgen tmenv binds = - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv (valsOfBinds binds) - remapAndRenameBinds g compgen tmenvinner binds vs', tmenvinner - -and remapAndRenameBinds g compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind g compgen tmenvinner) binds vs' -and remapAndRenameBind g compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExpr g compgen tmenvinner repr, letSeqPtOpt) - -and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = - let attribs2 = attribs |> remapAttribs g tmenv - let slotsig2 = remapSlotSig (remapAttribs g tmenv) tmenv slotsig - let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - let vs2, tmenvinner2 = List.mapFold (copyAndRemapAndBindVals g compgen) tmenvinner vs - let e2 = remapExpr g compgen tmenvinner2 e + let v', tmenv = copyAndRemapAndBindVal ctxt compgen tmenv v + remapAndRenameBind ctxt compgen tmenv bind v', tmenv + +and copyAndRemapAndBindBindings ctxt compgen tmenv binds = + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenv (valsOfBinds binds) + remapAndRenameBinds ctxt compgen tmenvinner binds vs', tmenvinner + +and remapAndRenameBinds ctxt compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind ctxt compgen tmenvinner) binds vs' +and remapAndRenameBind ctxt compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExprImpl ctxt compgen tmenvinner repr, letSeqPtOpt) + +and remapMethod ctxt compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = + let attribs2 = attribs |> remapAttribs ctxt tmenv + let slotsig2 = remapSlotSig (remapAttribs ctxt tmenv) tmenv slotsig + let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv tps + let vs2, tmenvinner2 = List.mapFold (copyAndRemapAndBindVals ctxt compgen) tmenvinner vs + let e2 = remapExprImpl ctxt compgen tmenvinner2 e TObjExprMethod(slotsig2, attribs2, tps2, vs2, e2, m) -and remapInterfaceImpl g compgen tmenv (ty, overrides) = - (remapType tmenv ty, List.map (remapMethod g compgen tmenv) overrides) +and remapInterfaceImpl ctxt compgen tmenv (ty, overrides) = + (remapType tmenv ty, List.map (remapMethod ctxt compgen tmenv) overrides) -and remapRecdField g tmenv x = +and remapRecdField ctxt tmenv x = { x with - rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv - rfield_pattribs = x.rfield_pattribs |> remapAttribs g tmenv - rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv } + rfield_type = x.rfield_type |> remapPossibleForallTyImpl ctxt tmenv + rfield_pattribs = x.rfield_pattribs |> remapAttribs ctxt tmenv + rfield_fattribs = x.rfield_fattribs |> remapAttribs ctxt tmenv } -and remapRecdFields g tmenv (x: TyconRecdFields) = - x.AllFieldsAsList |> List.map (remapRecdField g tmenv) |> Construct.MakeRecdFieldsTable +and remapRecdFields ctxt tmenv (x: TyconRecdFields) = + x.AllFieldsAsList |> List.map (remapRecdField ctxt tmenv) |> Construct.MakeRecdFieldsTable -and remapUnionCase g tmenv (x: UnionCase) = +and remapUnionCase ctxt tmenv (x: UnionCase) = { x with - FieldTable = x.FieldTable |> remapRecdFields g tmenv + FieldTable = x.FieldTable |> remapRecdFields ctxt tmenv ReturnType = x.ReturnType |> remapType tmenv - Attribs = x.Attribs |> remapAttribs g tmenv } + Attribs = x.Attribs |> remapAttribs ctxt tmenv } -and remapUnionCases g tmenv (x: TyconUnionData) = - x.UnionCasesAsList |> List.map (remapUnionCase g tmenv) |> Construct.MakeUnionCases +and remapUnionCases ctxt tmenv (x: TyconUnionData) = + x.UnionCasesAsList |> List.map (remapUnionCase ctxt tmenv) |> Construct.MakeUnionCases -and remapFsObjData g tmenv x = +and remapFsObjData ctxt tmenv x = { x with fsobjmodel_kind = (match x.fsobjmodel_kind with - | TFSharpDelegate slotsig -> TFSharpDelegate (remapSlotSig (remapAttribs g tmenv) tmenv slotsig) + | TFSharpDelegate slotsig -> TFSharpDelegate (remapSlotSig (remapAttribs ctxt tmenv) tmenv slotsig) | TFSharpClass | TFSharpInterface | TFSharpStruct | TFSharpEnum -> x.fsobjmodel_kind) fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) - fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields g tmenv } + fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields ctxt tmenv } -and remapTyconRepr g tmenv repr = +and remapTyconRepr ctxt tmenv repr = match repr with - | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData g tmenv x) - | TFSharpRecdRepr x -> TFSharpRecdRepr (remapRecdFields g tmenv x) - | TFSharpUnionRepr x -> TFSharpUnionRepr (remapUnionCases g tmenv x) + | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData ctxt tmenv x) + | TFSharpRecdRepr x -> TFSharpRecdRepr (remapRecdFields ctxt tmenv x) + | TFSharpUnionRepr x -> TFSharpUnionRepr (remapUnionCases ctxt tmenv x) | TILObjectRepr _ -> failwith "cannot remap IL type definitions" #if !NO_EXTENSIONTYPING | TProvidedNamespaceRepr _ -> repr | TProvidedTypeRepr info -> TProvidedTypeRepr { info with - LazyBaseType = info.LazyBaseType.Force (range0, g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy + LazyBaseType = info.LazyBaseType.Force (range0, ctxt.g.obj_ty) |> remapType tmenv |> LazyWithContext.NotLazy // The load context for the provided type contains TyconRef objects. We must remap these. // This is actually done on-demand (see the implementation of ProvidedTypeContext) ProvidedType = @@ -5560,33 +5594,33 @@ and remapTyconAug tmenv (x: TyconAugmentation) = tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) } -and remapTyconExnInfo g tmenv inp = +and remapTyconExnInfo ctxt tmenv inp = match inp with | TExnAbbrevRepr x -> TExnAbbrevRepr (remapTyconRef tmenv.tyconRefRemap x) - | TExnFresh x -> TExnFresh (remapRecdFields g tmenv x) + | TExnFresh x -> TExnFresh (remapRecdFields ctxt tmenv x) | TExnAsmRepr _ | TExnNone -> inp -and remapMemberInfo g m topValInfo ty ty' tmenv x = +and remapMemberInfo ctxt m topValInfo ty ty' tmenv x = // The slotsig in the ImplementedSlotSigs is w.r.t. the type variables in the value's type. // REVIEW: this is a bit gross. It would be nice if the slotsig was standalone assert (Option.isSome topValInfo) - let tpsOrig, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty m - let tps, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty' m + let tpsOrig, _, _, _ = GetMemberTypeInFSharpForm ctxt.g x.MemberFlags (Option.get topValInfo) ty m + let tps, _, _, _ = GetMemberTypeInFSharpForm ctxt.g x.MemberFlags (Option.get topValInfo) ty' m let renaming, _ = mkTyparToTyparRenaming tpsOrig tps let tmenv = { tmenv with tpinst = tmenv.tpinst @ renaming } { x with ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap - ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs g tmenv) tmenv) + ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs ctxt tmenv) tmenv) } -and copyAndRemapAndBindModTy g compgen tmenv mty = +and copyAndRemapAndBindModTy ctxt compgen tmenv mty = let tycons = allEntitiesOfModuleOrNamespaceTy mty let vs = allValsOfModuleOrNamespaceTy mty - let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs - remapModTy g compgen tmenvinner mty, tmenvinner + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs + remapModTy ctxt compgen tmenvinner mty, tmenvinner -and remapModTy g _compgen tmenv mty = - mapImmediateValsAndTycons (renameTycon g tmenv) (renameVal tmenv) mty +and remapModTy ctxt _compgen tmenv mty = + mapImmediateValsAndTycons (renameTycon ctxt.g tmenv) (renameVal tmenv) mty and renameTycon g tyenv x = let tcref = @@ -5609,13 +5643,13 @@ and copyTycon compgen (tycon: Tycon) = | _ -> Construct.NewClonedTycon tycon /// This operates over a whole nested collection of tycons and vals simultaneously *) -and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = +and copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs = let tycons' = tycons |> List.map (copyTycon compgen) let tmenvinner = bindTycons tycons tycons' tmenv // Values need to be copied and renamed. - let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenvinner vs + let vs', tmenvinner = copyAndRemapAndBindVals ctxt compgen tmenvinner vs // "if a type constructor is hidden then all its inner values and inner type constructors must also be hidden" // Hence we can just lookup the inner tycon/value mappings in the tables. @@ -5640,16 +5674,16 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = mkLocalTyconRef tycon tcref.Deref (tycons, tycons') ||> List.iter2 (fun tcd tcd' -> - let lookupTycon tycon = lookupTycon g tycon - let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs g tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) + let lookupTycon tycon = lookupTycon ctxt.g tycon + let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) tcd'.entity_typars <- LazyWithContext.NotLazy tps' - tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs g tmenvinner2 - tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2 + tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs ctxt tmenvinner2 + tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner2 let typeAbbrevR = tcd.TypeAbbrev |> Option.map (remapType tmenvinner2) tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value |> mapImmediateValsAndTycons lookupTycon lookupVal) - let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo g tmenvinner2 + let exnInfoR = tcd.ExceptionInfo |> remapTyconExnInfo ctxt tmenvinner2 match tcd'.entity_opt_data with | Some optData -> tcd'.entity_opt_data <- Some { optData with entity_tycon_abbrev = typeAbbrevR; entity_exn_info = exnInfoR } | _ -> @@ -5701,24 +5735,24 @@ and allValsOfModDef mdef = | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allValsOfModuleOrNamespaceTy mty } -and remapAndBindModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = - let mdef = copyAndRemapModDef g compgen tmenv mdef - let mty, tmenv = copyAndRemapAndBindModTy g compgen tmenv mty +and remapAndBindModuleOrNamespaceExprWithSig ctxt compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = + let mdef = copyAndRemapModDef ctxt compgen tmenv mdef + let mty, tmenv = copyAndRemapAndBindModTy ctxt compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m), tmenv -and remapModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = - let mdef = copyAndRemapModDef g compgen tmenv mdef - let mty = remapModTy g compgen tmenv mty +and remapModuleOrNamespaceExprWithSig ctxt compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = + let mdef = copyAndRemapModDef ctxt compgen tmenv mdef + let mty = remapModTy ctxt compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m) -and copyAndRemapModDef g compgen tmenv mdef = +and copyAndRemapModDef ctxt compgen tmenv mdef = let tycons = allEntitiesOfModDef mdef |> List.ofSeq let vs = allValsOfModDef mdef |> List.ofSeq - let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs - remapAndRenameModDef g compgen tmenvinner mdef + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs + remapAndRenameModDef ctxt compgen tmenvinner mdef -and remapAndRenameModDefs g compgen tmenv x = - List.map (remapAndRenameModDef g compgen tmenv) x +and remapAndRenameModDefs ctxt compgen tmenv x = + List.map (remapAndRenameModDef ctxt compgen tmenv) x and remapOpenDeclarations tmenv opens = opens |> List.map (fun od -> @@ -5727,52 +5761,74 @@ and remapOpenDeclarations tmenv opens = Types = od.Types |> List.map (remapType tmenv) }) -and remapAndRenameModDef g compgen tmenv mdef = +and remapAndRenameModDef ctxt compgen tmenv mdef = match mdef with | TMDefRec(isRec, opens, tycons, mbinds, m) -> // Abstract (virtual) vslots in the tycons at TMDefRec nodes are binders. They also need to be copied and renamed. let opensR = remapOpenDeclarations tmenv opens - let tyconsR = tycons |> List.map (renameTycon g tmenv) - let mbindsR = mbinds |> List.map (remapAndRenameModBind g compgen tmenv) + let tyconsR = tycons |> List.map (renameTycon ctxt.g tmenv) + let mbindsR = mbinds |> List.map (remapAndRenameModBind ctxt compgen tmenv) TMDefRec(isRec, opensR, tyconsR, mbindsR, m) | TMDefLet(bind, m) -> let v = bind.Var - let bind = remapAndRenameBind g compgen tmenv bind (renameVal tmenv v) + let bind = remapAndRenameBind ctxt compgen tmenv bind (renameVal tmenv v) TMDefLet(bind, m) | TMDefDo(e, m) -> - let e = remapExpr g compgen tmenv e + let e = remapExprImpl ctxt compgen tmenv e TMDefDo(e, m) | TMDefOpens opens -> let opens = remapOpenDeclarations tmenv opens TMDefOpens opens | TMDefs defs -> - let defs = remapAndRenameModDefs g compgen tmenv defs + let defs = remapAndRenameModDefs ctxt compgen tmenv defs TMDefs defs | TMAbstract mexpr -> - let mexpr = remapModuleOrNamespaceExprWithSig g compgen tmenv mexpr + let mexpr = remapModuleOrNamespaceExprWithSig ctxt compgen tmenv mexpr TMAbstract mexpr -and remapAndRenameModBind g compgen tmenv x = +and remapAndRenameModBind ctxt compgen tmenv x = match x with | ModuleOrNamespaceBinding.Binding bind -> let v2 = bind |> valOfBind |> renameVal tmenv - let bind2 = remapAndRenameBind g compgen tmenv bind v2 + let bind2 = remapAndRenameBind ctxt compgen tmenv bind v2 ModuleOrNamespaceBinding.Binding bind2 | ModuleOrNamespaceBinding.Module(mspec, def) -> - let mspec = renameTycon g tmenv mspec - let def = remapAndRenameModDef g compgen tmenv def + let mspec = renameTycon ctxt.g tmenv mspec + let def = remapAndRenameModDef ctxt compgen tmenv def ModuleOrNamespaceBinding.Module(mspec, def) -and remapImplFile g compgen tmenv mv = - mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig g compgen) tmenv mv +and remapImplFile ctxt compgen tmenv mv = + mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig ctxt compgen) tmenv mv + +// Entry points -let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst +let remapAttrib g tmenv attrib = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapAttribImpl ctxt tmenv attrib -let copyExpr g compgen e = remapExpr g compgen Remap.Empty e +let remapExpr g (compgen: ValCopyFlag) (tmenv: Remap) expr = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt compgen tmenv expr -let copyImplFile g compgen e = remapImplFile g compgen Remap.Empty e |> fst +let remapPossibleForallTy g tmenv ty = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapPossibleForallTyImpl ctxt tmenv ty -let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e +let copyModuleOrNamespaceType g compgen mtyp = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + copyAndRemapAndBindModTy ctxt compgen Remap.Empty mtyp |> fst + +let copyExpr g compgen e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt compgen Remap.Empty e + +let copyImplFile g compgen e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapImplFile ctxt compgen Remap.Empty e |> fst + +let instExpr g tpinst e = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapExprImpl ctxt CloneAll (mkInstRemap tpinst) e //-------------------------------------------------------------------------- // Replace Marks - adjust debugging marks when a lambda gets @@ -6097,30 +6153,29 @@ let isExpansiveUnderInstantiation g fty0 tyargs pargs argsl = loop fty1 argsl) let rec mkExprAppAux g f fty argsl m = - match argsl with - | [] -> f - | _ -> - // Always combine the term application with a type application - // - // Combine the term application with a term application, but only when f' is an under-applied value of known arity - match f with - | Expr.App (f', fty', tyargs, pargs, m2) + match argsl with + | [] -> f + | _ -> + // Always combine the term application with a type application + // + // Combine the term application with a term application, but only when f' is an under-applied value of known arity + match f with + | Expr.App (f0, fty0, tyargs, pargs, m2) when (isNil pargs || - (match stripExpr f' with + (match stripExpr f0 with | Expr.Val (v, _, _) -> match v.ValReprInfo with | Some info -> info.NumCurriedArgs > pargs.Length | None -> false | _ -> false)) && - not (isExpansiveUnderInstantiation g fty' tyargs pargs argsl) -> - primMkApp (f', fty') tyargs (pargs@argsl) (unionRanges m2 m) - - | _ -> - // Don't combine. 'f' is not an application - if not (isFunTy g fty) then error(InternalError("expected a function type", m)) - primMkApp (f, fty) [] argsl m + not (isExpansiveUnderInstantiation g fty0 tyargs pargs argsl) -> + primMkApp (f0, fty0) tyargs (pargs@argsl) (unionRanges m2 m) + | _ -> + // Don't combine. 'f' is not an application + if not (isFunTy g fty) then error(InternalError("expected a function type", m)) + primMkApp (f, fty) [] argsl m let rec mkAppsAux g f fty tyargsl argsl m = match tyargsl with @@ -6692,11 +6747,13 @@ let ExprFolder0 = type ExprFolders<'State> (folders: ExprFolder<'State>) = let mutable exprFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure let mutable exprNoInterceptFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure + let stackGuard = StackGuard(FoldExprStackGuardDepth) let rec exprsF z xs = List.fold exprFClosure z xs and exprF (z: 'State) (x: Expr) = + stackGuard.Guard <| fun () -> folders.exprIntercept exprFClosure exprNoInterceptFClosure z x and exprNoInterceptF (z: 'State) (x: Expr) = @@ -8732,7 +8789,8 @@ type ExprRewritingEnv = { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option PostTransform: Expr -> Expr option PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option - IsUnderQuotations: bool } + RewriteQuotations: bool + StackGuard: StackGuard } let rec rewriteBind env bind = match env.PreInterceptBinding with @@ -8748,18 +8806,19 @@ and rewriteBindStructure env (TBind(v, e, letSeqPtOpt)) = and rewriteBinds env binds = List.map (rewriteBind env) binds and RewriteExpr env expr = - match expr with - | LinearOpExpr _ - | LinearMatchExpr _ - | Expr.Let _ - | Expr.Sequential _ -> - rewriteLinearExpr env expr (fun e -> e) - | _ -> - let expr = - match preRewriteExpr env expr with - | Some expr -> expr - | None -> rewriteExprStructure env expr - postRewriteExpr env expr + env.StackGuard.Guard <| fun () -> + match expr with + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.Let _ + | Expr.Sequential _ -> + rewriteLinearExpr env expr (fun e -> e) + | _ -> + let expr = + match preRewriteExpr env expr with + | Some expr -> expr + | None -> rewriteExprStructure env expr + postRewriteExpr env expr and preRewriteExpr env expr = match env.PreIntercept with @@ -8787,7 +8846,7 @@ and rewriteExprStructure env expr = match dataCell.Value with | None -> None | Some (data1, data2) -> Some(map3Of4 (rewriteExprs env) data1, map3Of4 (rewriteExprs env) data2) - Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), ref data, isFromQueryExpression, m, ty) + Expr.Quote ((if env.RewriteQuotations then RewriteExpr env ast else ast), ref data, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> mkObjExpr(ty, basev, RewriteExpr env basecall, List.map (rewriteObjExprOverride env) overrides, @@ -8974,17 +9033,17 @@ let MakeExportRemapping viewedCcu (mspec: ModuleOrNamespace) = //------------------------------------------------------------------------ -let rec remapEntityDataToNonLocal g tmenv (d: Entity) = - let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv (d.entity_typars.Force(d.entity_range)) +let rec remapEntityDataToNonLocal ctxt tmenv (d: Entity) = + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv (d.entity_typars.Force(d.entity_range)) let typarsR = LazyWithContext.NotLazy tps' - let attribsR = d.entity_attribs |> remapAttribs g tmenvinner - let tyconReprR = d.entity_tycon_repr |> remapTyconRepr g tmenvinner + let attribsR = d.entity_attribs |> remapAttribs ctxt tmenvinner + let tyconReprR = d.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner let tyconAbbrevR = d.TypeAbbrev |> Option.map (remapType tmenvinner) let tyconTcaugR = d.entity_tycon_tcaug |> remapTyconAug tmenvinner let modulContentsR = MaybeLazy.Strict (d.entity_modul_contents.Value - |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) (remapValToNonLocal g tmenv)) - let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo g tmenvinner + |> mapImmediateValsAndTycons (remapTyconToNonLocal ctxt tmenv) (remapValToNonLocal ctxt tmenv)) + let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo ctxt tmenvinner { d with entity_typars = typarsR entity_attribs = attribsR @@ -8997,14 +9056,16 @@ let rec remapEntityDataToNonLocal g tmenv (d: Entity) = Some { dd with entity_tycon_abbrev = tyconAbbrevR; entity_exn_info = exnInfoR } | _ -> None } -and remapTyconToNonLocal g tmenv x = - x |> Construct.NewModifiedTycon (remapEntityDataToNonLocal g tmenv) +and remapTyconToNonLocal ctxt tmenv x = + x |> Construct.NewModifiedTycon (remapEntityDataToNonLocal ctxt tmenv) -and remapValToNonLocal g tmenv inp = +and remapValToNonLocal ctxt tmenv inp = // creates a new stamp - inp |> Construct.NewModifiedVal (remapValData g tmenv) + inp |> Construct.NewModifiedVal (remapValData ctxt tmenv) -let ApplyExportRemappingToEntity g tmenv x = remapTyconToNonLocal g tmenv x +let ApplyExportRemappingToEntity g tmenv x = + let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth) } + remapTyconToNonLocal ctxt tmenv x (* Which constraints actually get compiled to .NET constraints? *) let isCompiledOrWitnessPassingConstraint (g: TcGlobals) cx = diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index b0c3c2a83b3..2b9fbb8c049 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -8,6 +8,7 @@ open System.Collections.Immutable open Internal.Utilities.Collections open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -771,6 +772,10 @@ val CollectTyparsAndLocals: FreeVarOptions val CollectLocals: FreeVarOptions +val CollectLocalsWithStackGuard: unit -> FreeVarOptions + +val CollectTyparsAndLocalsWithStackGuard: unit -> FreeVarOptions + val CollectTypars: FreeVarOptions val CollectAllNoCaching: FreeVarOptions @@ -2328,7 +2333,8 @@ type ExprRewritingEnv = { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option PostTransform: Expr -> Expr option PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option - IsUnderQuotations: bool } + RewriteQuotations: bool + StackGuard: StackGuard } val RewriteDecisionTree: ExprRewritingEnv -> DecisionTree -> DecisionTree diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 0a41f5294e4..92b658375dc 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -1527,7 +1527,7 @@ let p_trait_sln sln st = let p_trait (TTrait(a, b, c, d, e, f)) st = - p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, !f) st + p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, f.Value) st let u_anonInfo_data st = let ccu, info, nms = u_tup3 u_ccuref u_bool (u_array u_ident) st @@ -2561,7 +2561,7 @@ and u_op st = and p_expr expr st = match expr with - | Expr.Link e -> p_expr !e st + | Expr.Link e -> p_expr e.Value st | Expr.Const (x, m, ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x, m, ty) st | Expr.Val (a, b, m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a, b, m) st | Expr.Op (a, b, c, d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a, b, c, d) st diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index e0a644e2697..dcc7d133ff4 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -70,7 +70,7 @@ module internal PervasiveAutoOpens = x.EndsWith(value, StringComparison.Ordinal) /// Get an initialization hole - let getHole r = match !r with None -> failwith "getHole" | Some x -> x + let getHole (r: _ ref) = match r.Value with None -> failwith "getHole" | Some x -> x let reportTime = let mutable tFirst =None @@ -1146,19 +1146,18 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co member x.Add (k, v) = LayeredMultiMap(contents.Add(k, v :: x.[k])) - member x.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] + member _.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] member x.AddAndMarkAsCollapsible (kvs: _[]) = let x = (x, kvs) ||> Array.fold (fun x (KeyValue(k, v)) -> x.Add(k, v)) x.MarkAsCollapsible() - member x.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) + member _.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) - member x.TryFind k = contents.TryFind k + member _.TryFind k = contents.TryFind k - member x.TryGetValue k = contents.TryGetValue k + member _.TryGetValue k = contents.TryGetValue k - member x.Values = contents.Values |> List.concat + member _.Values = contents.Values |> List.concat static member Empty : LayeredMultiMap<'Key, 'Value> = LayeredMultiMap LayeredMap.Empty - diff --git a/src/fsharp/absil/ilprint.fs b/src/fsharp/absil/ilprint.fs index 3a831bc1b5b..0a1a58c753b 100644 --- a/src/fsharp/absil/ilprint.fs +++ b/src/fsharp/absil/ilprint.fs @@ -20,9 +20,10 @@ let pretty () = true // -------------------------------------------------------------------- let tyvar_generator = - let i = ref 0 + let mutable i = 0 fun n -> - incr i; n + string !i + i <- i + 1 + n + string i // Carry an environment because the way we print method variables // depends on the gparams of the current scope. diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index dcfed598615..75cfd3dcacf 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -820,8 +820,11 @@ let writePdbInfo showTimes f fpdb info cvChunk = if sps.Length < 5000 then pdbDefineSequencePoints pdbw (getDocument spset.[0].Document) sps) + // Avoid stack overflow when writing linearly nested scopes + let stackGuard = StackGuard(100) // Write the scopes let rec writePdbScope parent sco = + stackGuard.Guard <| fun () -> if parent = None || sco.Locals.Length <> 0 || sco.Children.Length <> 0 then // Only nest scopes if the child scope is a different size from let nested = @@ -1009,7 +1012,8 @@ let rec allNamesOfScope acc (scope: PdbMethodScope) = and allNamesOfScopes acc (scopes: PdbMethodScope[]) = (acc, scopes) ||> Array.fold allNamesOfScope -let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) = +let rec pushShadowedLocals (stackGuard: StackGuard) (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) = + stackGuard.Guard <| fun () -> // Check if child scopes are properly nested if scope.Children |> Array.forall (fun child -> child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then @@ -1024,7 +1028,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) let renamed = [| for l in rename -> { l with Name = l.Name + " (shadowed)" } |] let localsToPush2 = [| yield! renamed; yield! unprocessed; yield! scope.Locals |] - let newChildren, splits = children |> Array.map (pushShadowedLocals localsToPush2) |> Array.unzip + let newChildren, splits = children |> Array.map (pushShadowedLocals stackGuard localsToPush2) |> Array.unzip // Check if a rename in any of the children forces a split if splits |> Array.exists id then @@ -1058,5 +1062,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) // 2. Adjust each child scope to also contain the locals from 'scope', // adding the text " (shadowed)" to the names of those with name conflicts. let unshadowScopes rootScope = - let result, _ = pushShadowedLocals [| |] rootScope - result + // Avoid stack overflow when writing linearly nested scopes + let stackGuard = StackGuard(100) + let result, _ = pushShadowedLocals stackGuard [| |] rootScope + result diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 31c555e7a9c..4c3fd769ccd 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -15,6 +15,8 @@ open FSharp.Compiler.TypeRelations //---------------------------------------------------------------------------- // Decide the set of mutable locals to promote to heap-allocated reference cells +let AutoboxRewriteStackGuardDepth = StackGuard.GetDepthOption "AutoboxRewrite" + type cenv = { g: TcGlobals amap: Import.ImportMap } @@ -30,7 +32,7 @@ let DecideEscapes syntacticArgs body = v.ValReprInfo.IsNone && not (Optimizer.IsKnownOnlyMutableBeforeUse (mkLocalValRef v)) - let frees = freeInExpr CollectLocals body + let frees = freeInExpr (CollectLocalsWithStackGuard()) body frees.FreeLocals |> Zset.filter isMutableEscape /// Find all the mutable locals that escape a lambda expression, ignoring the arguments to the lambda @@ -190,6 +192,7 @@ let TransformImplFile g amap implFile = { PreIntercept = Some(TransformExpr g nvs) PreInterceptBinding = Some(TransformBinding g nvs) PostTransform = (fun _ -> None) - IsUnderQuotations = false } + RewriteQuotations = false + StackGuard = StackGuard(AutoboxRewriteStackGuardDepth) } diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 69eb07e0810..d461f607afd 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -4,7 +4,9 @@ module internal FSharp.Compiler.CommandLineMain open System open System.Reflection +open System.Runtime open System.Runtime.CompilerServices +open System.Threading open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -30,7 +32,8 @@ let main(argv) = "fsc.exe" // Set the garbage collector to batch mode, which improves overall performance. - System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch + GCSettings.LatencyMode <- GCLatencyMode.Batch + Thread.CurrentThread.Name <- "F# Main Thread" // Set the initial phase to garbage collector to batch mode, which improves overall performance. use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 0a0352a7e2b..b45e059d8be 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -544,18 +544,6 @@ module UnmanagedProcessExecutionOptions = "HeapSetInformation() returned FALSE; LastError = 0x" + GetLastError().ToString("X").PadLeft(8, '0') + ".")) -[] -module StackGuard = - - open System.Runtime.CompilerServices - - [] - let private MaxUncheckedRecursionDepth = 20 - - let EnsureSufficientExecutionStack recursionDepth = - if recursionDepth > MaxUncheckedRecursionDepth then - RuntimeHelpers.EnsureSufficientExecutionStack () - [] type MaybeLazy<'T> = | Strict of 'T diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index bfa6f20296e..28d9f10b380 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -277,9 +277,6 @@ module AsyncUtil = module UnmanagedProcessExecutionOptions = val EnableHeapTerminationOnCorruption: unit -> unit -module StackGuard = - val EnsureSufficientExecutionStack: recursionDepth:int -> unit - [] type MaybeLazy<'T> = | Strict of 'T diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index 347db945c93..57bb550d972 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -144,7 +144,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = | Some x -> Some (Tainted(context,x)) member this.PUntaint(f,range:range) = this.Protect f range + member this.PUntaintNoFailure f = this.PUntaint(f, range0) + /// Access the target object directly. Use with extreme caution. member this.AccessObjectDirectly = value diff --git a/tests/FSharp.Test.Utilities/TestFramework.fs b/tests/FSharp.Test.Utilities/TestFramework.fs index 07b9c557ea1..df5e55708dc 100644 --- a/tests/FSharp.Test.Utilities/TestFramework.fs +++ b/tests/FSharp.Test.Utilities/TestFramework.fs @@ -216,6 +216,7 @@ type TestConfig = FSI : string #if !NETCOREAPP FSIANYCPU : string + FSCANYCPU : string #endif FSI_FOR_SCRIPTS : string FSharpBuild : string @@ -335,8 +336,9 @@ let config configurationName envVars = let FSI_FOR_SCRIPTS = requireArtifact FSI_PATH let FSI = requireArtifact FSI_PATH #if !NETCOREAPP - let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.exe") + let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe") + let FSCANYCPU = requireArtifact ("fscAnyCpu" ++ configurationName ++ fscArchitecture ++ "fscAnyCpu.exe") #else let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.dll") #endif @@ -360,6 +362,7 @@ let config configurationName envVars = FSC = FSC FSI = FSI #if !NETCOREAPP + FSCANYCPU = FSCANYCPU FSIANYCPU = FSIANYCPU #endif FSI_FOR_SCRIPTS = FSI_FOR_SCRIPTS @@ -392,6 +395,7 @@ let logConfig (cfg: TestConfig) = log "DOTNET_ROOT = %s" cfg.DotNetRoot #else log "FSIANYCPU = %s" cfg.FSIANYCPU + log "FSCANYCPU = %s" cfg.FSCANYCPU #endif log "FSI_FOR_SCRIPTS = %s" cfg.FSI_FOR_SCRIPTS log "fsi_flags = %s" cfg.fsi_flags diff --git a/tests/fsharp/TypeProviderTests.fs b/tests/fsharp/TypeProviderTests.fs index e689c2775a1..3a2ca54fef1 100644 --- a/tests/fsharp/TypeProviderTests.fs +++ b/tests/fsharp/TypeProviderTests.fs @@ -26,11 +26,11 @@ open FSharp.Compiler.IO #if NETCOREAPP // Use these lines if you want to test CoreCLR -let FSC_BASIC = FSC_CORECLR -let FSI_BASIC = FSI_CORECLR +let FSC_OPTIMIZED = FSC_NETCORE (true, false) +let FSI = FSI_NETCORE #else -let FSC_BASIC = FSC_OPT_PLUS_DEBUG -let FSI_BASIC = FSI_FILE +let FSC_OPTIMIZED = FSC_NETFX (true, false) +let FSI = FSI_NETFX #endif let inline getTestsDirectory dir = getTestsDirectory __SOURCE_DIRECTORY__ dir @@ -147,11 +147,11 @@ let helloWorld p = peverify cfg (bincompat2 ++ "testlib_client.exe") [] -let ``helloWorld fsc`` () = helloWorld FSC_BASIC +let ``helloWorld fsc`` () = helloWorld FSC_OPTIMIZED #if !NETCOREAPP [] -let ``helloWorld fsi`` () = helloWorld FSI_STDIN +let ``helloWorld fsi`` () = helloWorld FSI_NETFX_STDIN #endif [] diff --git a/tests/fsharp/core/innerpoly/test.fsx b/tests/fsharp/core/innerpoly/test.fsx index 012df22100f..4dd3e65f7cb 100644 --- a/tests/fsharp/core/innerpoly/test.fsx +++ b/tests/fsharp/core/innerpoly/test.fsx @@ -448,7 +448,7 @@ module Bug11620A = (fun () -> getService) // The generated signature for this bug repro has mistakes, we are not enabling it yet -#if !GENERATED_SIGNATURE +#if !FSC_NETFX_TEST_GENERATED_SIGNATURE module Bug11620B = type Data = interface end diff --git a/tests/fsharp/readme.md b/tests/fsharp/readme.md index 42960c28c31..43ba0b0ad0f 100644 --- a/tests/fsharp/readme.md +++ b/tests/fsharp/readme.md @@ -11,7 +11,7 @@ The framework and utilities can be found in test-framework.fs, single-test.fs, c test cases look similar to: ```` [] - let ``array-FSI_BASIC`` () = singleTestBuildAndRun "core/array" FSI_BASIC + let ``array-FSI`` () = singleTestBuildAndRun "core/array" FSI ```` This test case builds and runs the test case in the folder core/array diff --git a/tests/fsharp/regression/12322/test.fsx b/tests/fsharp/regression/12322/test.fsx new file mode 100644 index 00000000000..755937aedd4 --- /dev/null +++ b/tests/fsharp/regression/12322/test.fsx @@ -0,0 +1,1494 @@ +#r "nuget: FsCheck, 3.0.0-alpha4" + +// See https://github.com/dotnet/fsharp/pull/12420 and https://github.com/dotnet/fsharp/issues/12322 + +type ReproBuilder () = + member _.Delay x = printfn "Delay"; x () + member _.Yield (x) = printfn "Yield"; x + member _.Combine (x, y) = printfn "Combine"; x + y + +let repro = ReproBuilder () + +// The de-sugaring of this is a mass of nested function calls +let reallyBigComputationExpression () = + repro { + // Commenting out some of the below is enough to avoid StackOverflow on my machine. + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + 4 + 0 + 1 + 2 + 3 + } + +let f x = printfn "call"; printfn "call"; printfn "call"; printfn "call"; x + +let manyPipes () = + 1 |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + |> f |> f |> f |> f |> f |> f |> f |> f |> f |> f + + +let deepCalls () = + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + f(f(f(f(f(f(f(f(f(f( + 1 + )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +open FsCheck + +/// This was another repro for computation expressions +let g = + gen { + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + let! _ = Arb.generate + return () + } + +/// This was failing when writing debug scopes +module LotsOfLets = + //let a1 = "foo" + let a2 = "foo" + let a3 = "foo" + let a4 = "foo" + let a5 = "foo" + let a6 = "foo" + let a7 = "foo" + let a8 = "foo" + let a9 = "foo" + let a10 = "foo" + let a11 = "foo" + let a12 = "foo" + let a13 = "foo" + let a14 = "foo" + let a15 = "foo" + let a16 = "foo" + let a17 = "foo" + let a18 = "foo" + let a19 = "foo" + let a20 = "foo" + let a21 = "foo" + let a22 = "foo" + let a23 = "foo" + let a24 = "foo" + let a25 = "foo" + let a26 = "foo" + let a27 = "foo" + let a28 = "foo" + let a29 = "foo" + let a30 = "foo" + let a31 = "foo" + let a32 = "foo" + let a33 = "foo" + let a34 = "foo" + let a35 = "foo" + let a36 = "foo" + let a37 = "foo" + let a38 = "foo" + let a39 = "foo" + let a40 = "foo" + let a41 = "foo" + let a42 = "foo" + let a43 = "foo" + let a44 = "foo" + let a45 = "foo" + let a46 = "foo" + let a47 = "foo" + let a48 = "foo" + let a49 = "foo" + let a50 = "foo" + let a51 = "foo" + let a52 = "foo" + let a53 = "foo" + let a54 = "foo" + let a55 = "foo" + let a56 = "foo" + let a57 = "foo" + let a58 = "foo" + let a59 = "foo" + let a60 = "foo" + let a61 = "foo" + let a62 = "foo" + let a63 = "foo" + let a64 = "foo" + let a65 = "foo" + let a66 = "foo" + let a67 = "foo" + let a68 = "foo" + let a69 = "foo" + let a70 = "foo" + let a71 = "foo" + let a72 = "foo" + let a73 = "foo" + let a74 = "foo" + let a75 = "foo" + let a76 = "foo" + let a77 = "foo" + let a78 = "foo" + let a79 = "foo" + let a80 = "foo" + let a81 = "foo" + let a82 = "foo" + let a83 = "foo" + let a84 = "foo" + let a85 = "foo" + let a86 = "foo" + let a87 = "foo" + let a88 = "foo" + let a89 = "foo" + let a90 = "foo" + let a91 = "foo" + let a92 = "foo" + let a93 = "foo" + let a94 = "foo" + let a95 = "foo" + let a96 = "foo" + let a97 = "foo" + let a98 = "foo" + let a99 = "foo" + let a100 = "foo" + let a101 = "foo" + let a102 = "foo" + let a103 = "foo" + let a104 = "foo" + let a105 = "foo" + let a106 = "foo" + let a107 = "foo" + let a108 = "foo" + let a109 = "foo" + let a110 = "foo" + let a111 = "foo" + let a112 = "foo" + let a113 = "foo" + let a114 = "foo" + let a115 = "foo" + let a116 = "foo" + let a117 = "foo" + let a118 = "foo" + let a119 = "foo" + let a120 = "foo" + let a121 = "foo" + let a122 = "foo" + let a123 = "foo" + let a124 = "foo" + let a125 = "foo" + let a126 = "foo" + let a127 = "foo" + let a128 = "foo" + let a129 = "foo" + let a130 = "foo" + let a131 = "foo" + let a132 = "foo" + let a133 = "foo" + let a134 = "foo" + let a135 = "foo" + let a136 = "foo" + let a137 = "foo" + let a138 = "foo" + let a139 = "foo" + let a140 = "foo" + let a141 = "foo" + let a142 = "foo" + let a143 = "foo" + let a144 = "foo" + let a145 = "foo" + let a146 = "foo" + let a147 = "foo" + let a148 = "foo" + let a149 = "foo" + let a150 = "foo" + let a151 = "foo" + let a152 = "foo" + let a153 = "foo" + let a154 = "foo" + let a155 = "foo" + let a156 = "foo" + let a157 = "foo" + let a158 = "foo" + let a159 = "foo" + let a160 = "foo" + let a161 = "foo" + let a162 = "foo" + let a163 = "foo" + let a164 = "foo" + let a165 = "foo" + let a166 = "foo" + let a167 = "foo" + let a168 = "foo" + let a169 = "foo" + let a170 = "foo" + let a171 = "foo" + let a172 = "foo" + let a173 = "foo" + let a174 = "foo" + let a175 = "foo" + let a176 = "foo" + let a177 = "foo" + let a178 = "foo" + let a179 = "foo" + let a180 = "foo" + let a181 = "foo" + let a182 = "foo" + let a183 = "foo" + let a184 = "foo" + let a185 = "foo" + let a186 = "foo" + let a187 = "foo" + let a188 = "foo" + let a189 = "foo" + let a190 = "foo" + let a191 = "foo" + let a192 = "foo" + let a193 = "foo" + let a194 = "foo" + let a195 = "foo" + let a196 = "foo" + let a197 = "foo" + let a198 = "foo" + let a199 = "foo" + let a200 = "foo" + let a201 = "foo" + let a202 = "foo" + let a203 = "foo" + let a204 = "foo" + let a205 = "foo" + let a206 = "foo" + let a207 = "foo" + let a208 = "foo" + let a209 = "foo" + let a210 = "foo" + let a211 = "foo" + let a212 = "foo" + let a213 = "foo" + let a214 = "foo" + let a215 = "foo" + let a216 = "foo" + let a217 = "foo" + let a218 = "foo" + let a219 = "foo" + let a220 = "foo" + let a221 = "foo" + let a222 = "foo" + let a223 = "foo" + let a224 = "foo" + let a225 = "foo" + let a226 = "foo" + let a227 = "foo" + let a228 = "foo" + let a229 = "foo" + let a230 = "foo" + let a231 = "foo" + let a232 = "foo" + let a233 = "foo" + let a234 = "foo" + let a235 = "foo" + let a236 = "foo" + let a237 = "foo" + let a238 = "foo" + let a239 = "foo" + let a240 = "foo" + let a241 = "foo" + let a242 = "foo" + let a243 = "foo" + let a244 = "foo" + let a245 = "foo" + let a246 = "foo" + let a247 = "foo" + let a248 = "foo" + let a249 = "foo" + let a250 = "foo" + let a251 = "foo" + let a252 = "foo" + let a253 = "foo" + let a254 = "foo" + let a255 = "foo" + let a256 = "foo" + let a257 = "foo" + let a258 = "foo" + let a259 = "foo" + let a260 = "foo" + let a261 = "foo" + let a262 = "foo" + let a263 = "foo" + let a264 = "foo" + let a265 = "foo" + let a266 = "foo" + let a267 = "foo" + let a268 = "foo" + let a269 = "foo" + let a270 = "foo" + let a271 = "foo" + let a272 = "foo" + let a273 = "foo" + let a274 = "foo" + let a275 = "foo" + let a276 = "foo" + let a277 = "foo" + let a278 = "foo" + let a279 = "foo" + let a280 = "foo" + let a281 = "foo" + let a282 = "foo" + let a283 = "foo" + let a284 = "foo" + let a285 = "foo" + let a286 = "foo" + let a287 = "foo" + let a288 = "foo" + let a289 = "foo" + let a290 = "foo" + let a291 = "foo" + let a292 = "foo" + let a293 = "foo" + let a294 = "foo" + let a295 = "foo" + let a296 = "foo" + let a297 = "foo" + let a298 = "foo" + let a299 = "foo" + let a300 = "foo" + let a301 = "foo" + let a302 = "foo" + let a303 = "foo" + let a304 = "foo" + let a305 = "foo" + let a306 = "foo" + let a307 = "foo" + let a308 = "foo" + let a309 = "foo" + let a310 = "foo" + let a311 = "foo" + let a312 = "foo" + let a313 = "foo" + let a314 = "foo" + let a315 = "foo" + let a316 = "foo" + let a317 = "foo" + let a318 = "foo" + let a319 = "foo" + let a320 = "foo" + let a321 = "foo" + let a322 = "foo" + let a323 = "foo" + let a324 = "foo" + let a325 = "foo" + let a326 = "foo" + let a327 = "foo" + let a328 = "foo" + let a329 = "foo" + let a330 = "foo" + let a331 = "foo" + let a332 = "foo" + let a333 = "foo" + let a334 = "foo" + let a335 = "foo" + let a336 = "foo" + let a337 = "foo" + let a338 = "foo" + let a339 = "foo" + let a340 = "foo" + let a341 = "foo" + let a342 = "foo" + let a343 = "foo" + let a344 = "foo" + let a345 = "foo" + let a346 = "foo" + let a347 = "foo" + let a348 = "foo" + let a349 = "foo" + let a350 = "foo" + let a351 = "foo" + let a352 = "foo" + let a353 = "foo" + let a354 = "foo" + let a355 = "foo" + let a356 = "foo" + let a357 = "foo" + let a358 = "foo" + let a359 = "foo" + let a360 = "foo" + let a361 = "foo" + let a362 = "foo" + let a363 = "foo" + let a364 = "foo" + let a365 = "foo" + let a366 = "foo" + let a367 = "foo" + let a368 = "foo" + let a369 = "foo" + let a370 = "foo" + let a371 = "foo" + let a372 = "foo" + let a373 = "foo" + let a374 = "foo" + let a375 = "foo" + let a376 = "foo" + let a377 = "foo" + let a378 = "foo" + let a379 = "foo" + let a380 = "foo" + let a381 = "foo" + let a382 = "foo" + let a383 = "foo" + let a384 = "foo" + let a385 = "foo" + let a386 = "foo" + let a387 = "foo" + let a388 = "foo" + let a389 = "foo" + let a390 = "foo" + let a391 = "foo" + let a392 = "foo" + let a393 = "foo" + let a394 = "foo" + let a395 = "foo" + let a396 = "foo" + let a397 = "foo" + let a398 = "foo" + let a399 = "foo" + let a400 = "foo" + let a401 = "foo" + let a402 = "foo" + let a403 = "foo" + let a404 = "foo" + let a405 = "foo" + let a406 = "foo" + let a407 = "foo" + let a408 = "foo" + let a409 = "foo" + let a410 = "foo" + let a411 = "foo" + let a412 = "foo" + let a413 = "foo" + let a414 = "foo" + let a415 = "foo" + let a416 = "foo" + let a417 = "foo" + let a418 = "foo" + let a419 = "foo" + let a420 = "foo" + let a421 = "foo" + let a422 = "foo" + let a423 = "foo" + let a424 = "foo" + let a425 = "foo" + let a426 = "foo" + let a427 = "foo" + let a428 = "foo" + let a429 = "foo" + let a430 = "foo" + let a431 = "foo" + let a432 = "foo" + let a433 = "foo" + let a434 = "foo" + let a435 = "foo" + let a436 = "foo" + let a437 = "foo" + let a438 = "foo" + let a439 = "foo" + let a440 = "foo" + let a441 = "foo" + let a442 = "foo" + let a443 = "foo" + let a444 = "foo" + let a445 = "foo" + let a446 = "foo" + let a447 = "foo" + let a448 = "foo" + let a449 = "foo" + let a450 = "foo" + let a451 = "foo" + let a452 = "foo" + let a453 = "foo" + let a454 = "foo" + let a455 = "foo" + let a456 = "foo" + let a457 = "foo" + let a458 = "foo" + let a459 = "foo" + let a460 = "foo" + let a461 = "foo" + let a462 = "foo" + let a463 = "foo" + let a464 = "foo" + let a465 = "foo" + let a466 = "foo" + let a467 = "foo" + let a468 = "foo" + let a469 = "foo" + let a470 = "foo" + let a471 = "foo" + let a472 = "foo" + let a473 = "foo" + let a474 = "foo" + let a475 = "foo" + let a476 = "foo" + let a477 = "foo" + let a478 = "foo" + let a479 = "foo" + let a480 = "foo" + let a481 = "foo" + let a482 = "foo" + let a483 = "foo" +#if PORTABLE_PDB // 32-bit fsc.exe --debug:full fails in C++ code for the scope emit for any more than this. + let a484 = "foo" + let a485 = "foo" + let a486 = "foo" + let b2 = "foo" + let b3 = "foo" + let b4 = "foo" + let b5 = "foo" + let b6 = "foo" + let b7 = "foo" + let b8 = "foo" + let b9 = "foo" + let b10 = "foo" + let b11 = "foo" + let b12 = "foo" + let b13 = "foo" + let b14 = "foo" + let b15 = "foo" + let b16 = "foo" + let b17 = "foo" + let b18 = "foo" + let b19 = "foo" + let b20 = "foo" + let b21 = "foo" + let b22 = "foo" + let b23 = "foo" + let b24 = "foo" + let b25 = "foo" + let b26 = "foo" + let b27 = "foo" + let b28 = "foo" + let b29 = "foo" + let b30 = "foo" + let b31 = "foo" + let b32 = "foo" + let b33 = "foo" + let b34 = "foo" + let b35 = "foo" + let b36 = "foo" + let b37 = "foo" + let b38 = "foo" + let b39 = "foo" + let b40 = "foo" + let b41 = "foo" + let b42 = "foo" + let b43 = "foo" + let b44 = "foo" + let b45 = "foo" + let b46 = "foo" + let b47 = "foo" + let b48 = "foo" + let b49 = "foo" + let b50 = "foo" + let b51 = "foo" + let b52 = "foo" + let b53 = "foo" + let b54 = "foo" + let b55 = "foo" + let b56 = "foo" + let b57 = "foo" + let b58 = "foo" + let b59 = "foo" + let b60 = "foo" + let b61 = "foo" + let b62 = "foo" + let b63 = "foo" + let b64 = "foo" + let b65 = "foo" + let b66 = "foo" + let b67 = "foo" + let b68 = "foo" + let b69 = "foo" + let b70 = "foo" + let b71 = "foo" + let b72 = "foo" + let b73 = "foo" + let b74 = "foo" + let b75 = "foo" + let b76 = "foo" + let b77 = "foo" + let b78 = "foo" + let b79 = "foo" + let b80 = "foo" + let b81 = "foo" + let b82 = "foo" + let b83 = "foo" + let b84 = "foo" + let b85 = "foo" + let b86 = "foo" + let b87 = "foo" + let b88 = "foo" + let b89 = "foo" + let b90 = "foo" + let b91 = "foo" + let b92 = "foo" + let b93 = "foo" + let b94 = "foo" + let b95 = "foo" + let b96 = "foo" + let b97 = "foo" + let b98 = "foo" + let b99 = "foo" + let b100 = "foo" + let b101 = "foo" + let b102 = "foo" + let b103 = "foo" + let b104 = "foo" + let b105 = "foo" + let b106 = "foo" + let b107 = "foo" + let b108 = "foo" + let b109 = "foo" + let b110 = "foo" + let b111 = "foo" + let b112 = "foo" + let b113 = "foo" + let b114 = "foo" + let b115 = "foo" + let b116 = "foo" + let b117 = "foo" + let b118 = "foo" + let b119 = "foo" + let b120 = "foo" + let b121 = "foo" + let b122 = "foo" + let b123 = "foo" + let b124 = "foo" + let b125 = "foo" + let b126 = "foo" + let b127 = "foo" + let b128 = "foo" + let b129 = "foo" + let b130 = "foo" + let b131 = "foo" + let b132 = "foo" + let b133 = "foo" + let b134 = "foo" + let b135 = "foo" + let b136 = "foo" + let b137 = "foo" + let b138 = "foo" + let b139 = "foo" + let b140 = "foo" + let b141 = "foo" + let b142 = "foo" + let b143 = "foo" + let b144 = "foo" + let b145 = "foo" + let b146 = "foo" + let b147 = "foo" + let b148 = "foo" + let b149 = "foo" + let b150 = "foo" + let b151 = "foo" + let b152 = "foo" + let b153 = "foo" + let b154 = "foo" + let b155 = "foo" + let b156 = "foo" + let b157 = "foo" + let b158 = "foo" + let b159 = "foo" + let b160 = "foo" + let b161 = "foo" + let b162 = "foo" + let b163 = "foo" + let b164 = "foo" + let b165 = "foo" + let b166 = "foo" + let b167 = "foo" + let b168 = "foo" + let b169 = "foo" + let b170 = "foo" + let b171 = "foo" + let b172 = "foo" + let b173 = "foo" + let b174 = "foo" + let b175 = "foo" + let b176 = "foo" + let b177 = "foo" + let b178 = "foo" + let b179 = "foo" + let b180 = "foo" + let b181 = "foo" + let b182 = "foo" + let b183 = "foo" + let b184 = "foo" + let b185 = "foo" + let b186 = "foo" + let b187 = "foo" + let b188 = "foo" + let b189 = "foo" + let b190 = "foo" + let b191 = "foo" + let b192 = "foo" + let b193 = "foo" + let b194 = "foo" + let b195 = "foo" + let b196 = "foo" + let b197 = "foo" + let b198 = "foo" + let b199 = "foo" + let b200 = "foo" + let b201 = "foo" + let b202 = "foo" + let b203 = "foo" + let b204 = "foo" + let b205 = "foo" + let b206 = "foo" + let b207 = "foo" + let b208 = "foo" + let b209 = "foo" + let b210 = "foo" + let b211 = "foo" + let b212 = "foo" + let b213 = "foo" + let b214 = "foo" + let b215 = "foo" + let b216 = "foo" + let b217 = "foo" + let b218 = "foo" + let b219 = "foo" + let b220 = "foo" + let b221 = "foo" + let b222 = "foo" + let b223 = "foo" + let b224 = "foo" + let b225 = "foo" + let b226 = "foo" + let b227 = "foo" + let b228 = "foo" + let b229 = "foo" + let b230 = "foo" + let b231 = "foo" + let b232 = "foo" + let b233 = "foo" + let b234 = "foo" + let b235 = "foo" + let b236 = "foo" + let b237 = "foo" + let b238 = "foo" + let b239 = "foo" + let b240 = "foo" + let b241 = "foo" + let b242 = "foo" + let b243 = "foo" + let b244 = "foo" + let b245 = "foo" + let b246 = "foo" + let b247 = "foo" + let b248 = "foo" + let b249 = "foo" + let b250 = "foo" + let b251 = "foo" + let b252 = "foo" + let b253 = "foo" + let b254 = "foo" + let b255 = "foo" + let b256 = "foo" + let b257 = "foo" + let b258 = "foo" + let b259 = "foo" + let b260 = "foo" + let b261 = "foo" + let b262 = "foo" + let b263 = "foo" + let b264 = "foo" + let b265 = "foo" + let b266 = "foo" + let b267 = "foo" + let b268 = "foo" + let b269 = "foo" + let b270 = "foo" + let b271 = "foo" + let b272 = "foo" + let b273 = "foo" + let b274 = "foo" + let b275 = "foo" + let b276 = "foo" + let b277 = "foo" + let b278 = "foo" + let b279 = "foo" + let b280 = "foo" + let b281 = "foo" + let b282 = "foo" + let b283 = "foo" + let b284 = "foo" + let b285 = "foo" + let b286 = "foo" + let b287 = "foo" + let b288 = "foo" + let b289 = "foo" + let b290 = "foo" + let b291 = "foo" + let b292 = "foo" + let b293 = "foo" + let b294 = "foo" + let b295 = "foo" + let b296 = "foo" + let b297 = "foo" + let b298 = "foo" + let b299 = "foo" + let b300 = "foo" + let b301 = "foo" + let b302 = "foo" + let b303 = "foo" + let b304 = "foo" + let b305 = "foo" + let b306 = "foo" + let b307 = "foo" + let b308 = "foo" + let b309 = "foo" + let b310 = "foo" + let b311 = "foo" + let b312 = "foo" + let b313 = "foo" + let b314 = "foo" + let b315 = "foo" + let b316 = "foo" + let b317 = "foo" + let b318 = "foo" + let b319 = "foo" + let b320 = "foo" + let b321 = "foo" + let b322 = "foo" + let b323 = "foo" + let b324 = "foo" + let b325 = "foo" + let b326 = "foo" + let b327 = "foo" + let b328 = "foo" + let b329 = "foo" + let b330 = "foo" + let b331 = "foo" + let b332 = "foo" + let b333 = "foo" + let b334 = "foo" + let b335 = "foo" + let b336 = "foo" + let b337 = "foo" + let b338 = "foo" + let b339 = "foo" + let b340 = "foo" + let b341 = "foo" + let b342 = "foo" + let b343 = "foo" + let b344 = "foo" + let b345 = "foo" + let b346 = "foo" + let b347 = "foo" + let b348 = "foo" + let b349 = "foo" + let b350 = "foo" + let b351 = "foo" + let b352 = "foo" + let b353 = "foo" + let b354 = "foo" + let b355 = "foo" + let b356 = "foo" + let b357 = "foo" + let b358 = "foo" + let b359 = "foo" + let b360 = "foo" + let b361 = "foo" + let b362 = "foo" + let b363 = "foo" + let b364 = "foo" + let b365 = "foo" + let b366 = "foo" + let b367 = "foo" + let b368 = "foo" + let b369 = "foo" + let b370 = "foo" + let b371 = "foo" + let b372 = "foo" + let b373 = "foo" + let b374 = "foo" + let b375 = "foo" + let b376 = "foo" + let b377 = "foo" + let b378 = "foo" + let b379 = "foo" + let b380 = "foo" + let b381 = "foo" + let b382 = "foo" + let b383 = "foo" + let b384 = "foo" + let b385 = "foo" + let b386 = "foo" + let b387 = "foo" + let b388 = "foo" + let b389 = "foo" + let b390 = "foo" + let b391 = "foo" + let b392 = "foo" + let b393 = "foo" + let b394 = "foo" + let b395 = "foo" + let b396 = "foo" + let b397 = "foo" + let b398 = "foo" + let b399 = "foo" + let b400 = "foo" + let b401 = "foo" + let b402 = "foo" + let b403 = "foo" + let b404 = "foo" + let b405 = "foo" + let b406 = "foo" + let b407 = "foo" + let b408 = "foo" + let b409 = "foo" + let b410 = "foo" + let b411 = "foo" + let b412 = "foo" + let b413 = "foo" + let b414 = "foo" + let b415 = "foo" + let b416 = "foo" + let b417 = "foo" + let b418 = "foo" + let b419 = "foo" + let b420 = "foo" + let b421 = "foo" + let b422 = "foo" + let b423 = "foo" + let b424 = "foo" + let b425 = "foo" + let b426 = "foo" + let b427 = "foo" + let b428 = "foo" + let b429 = "foo" + let b430 = "foo" + let b431 = "foo" + let b432 = "foo" + let b433 = "foo" + let b434 = "foo" + let b435 = "foo" + let b436 = "foo" + let b437 = "foo" + let b438 = "foo" + let b439 = "foo" + let b440 = "foo" + let b441 = "foo" + let b442 = "foo" + let b443 = "foo" + let b444 = "foo" + let b445 = "foo" + let b446 = "foo" + let b447 = "foo" + let b448 = "foo" + let b449 = "foo" + let b450 = "foo" + let b451 = "foo" + let b452 = "foo" + let b453 = "foo" + let b454 = "foo" + let b455 = "foo" + let b456 = "foo" + let b457 = "foo" + let b458 = "foo" + let b459 = "foo" + let b460 = "foo" + let b461 = "foo" + let b462 = "foo" + let b463 = "foo" + let b464 = "foo" + let b465 = "foo" + let b466 = "foo" + let b467 = "foo" + let b468 = "foo" + let b469 = "foo" + let b470 = "foo" + let b471 = "foo" + let b472 = "foo" + let b473 = "foo" + let b474 = "foo" + let b475 = "foo" + let b476 = "foo" + let b477 = "foo" + let b478 = "foo" + let b479 = "foo" + let b480 = "foo" + let b481 = "foo" + let b482 = "foo" + let b483 = "foo" + let b484 = "foo" + let b485 = "foo" + let b486 = "foo" +#endif + +// This is a compilation test, not a lot actually happens in the test +do (System.Console.Out.WriteLine "Test Passed"; + System.IO.File.WriteAllText("test.ok", "ok"); + exit 0) + diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index 68cb5c0f3d6..a80a6d3f96f 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -8,18 +8,15 @@ open HandleExpects open FSharp.Compiler.IO type Permutation = - | FSC_CORECLR - | FSC_CORECLR_OPT_MINUS - | FSC_CORECLR_BUILDONLY - | FSI_CORECLR -#if !NETCOREAPP - | FSI_FILE - | FSI_STDIN - | GENERATED_SIGNATURE - | FSC_BUILDONLY - | FSC_OPT_MINUS_DEBUG - | FSC_OPT_PLUS_DEBUG - | AS_DLL +#if NETCOREAPP + | FSC_NETCORE of optimized: bool * buildOnly: bool + | FSI_NETCORE +#else + | FSC_NETFX of optimized: bool * buildOnly: bool + | FSI_NETFX + | FSI_NETFX_STDIN + | FSC_NETFX_TEST_GENERATED_SIGNATURE + | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL #endif // Because we build programs ad dlls the compiler will copy an fsharp.core.dll into the build directory @@ -306,18 +303,14 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = printfn "Filename: %s" projectFileName match p with - | FSC_CORECLR -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true false - | FSC_CORECLR_OPT_MINUS -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" false false - | FSC_CORECLR_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true true - | FSI_CORECLR -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false - -#if !NETCOREAPP - | FSC_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false true - | FSC_OPT_PLUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" true false - | FSC_OPT_MINUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false false - | FSI_FILE -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false - - | FSI_STDIN -> +#if NETCOREAPP + | FSC_NETCORE (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" optimized buildOnly + | FSI_NETCORE -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false +#else + | FSC_NETFX (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" optimized buildOnly + | FSI_NETFX -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false + + | FSI_NETFX_STDIN -> use _cleanup = (cleanUpFSharpCore cfg) use testOkFile = new FileGuard (getfullpath cfg "test.ok") let sources = extraSources |> List.filter (fileExists cfg) @@ -326,7 +319,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = testOkFile.CheckExists() - | GENERATED_SIGNATURE -> + | FSC_NETFX_TEST_GENERATED_SIGNATURE -> use _cleanup = (cleanUpFSharpCore cfg) let source1 = @@ -337,7 +330,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = source1 |> Option.iter (fun from -> copy_y cfg from "tmptest.fs") log "Generated signature file..." - fsc cfg "%s --sig:tmptest.fsi --define:GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"] + fsc cfg "%s --sig:tmptest.fsi --define:FSC_NETFX_TEST_GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"] log "Compiling against generated signature file..." fsc cfg "%s -o:tmptest1.exe" cfg.fsc_flags ["tmptest.fsi";"tmptest.fs"] @@ -345,7 +338,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion = log "Verifying built .exe..." peverify cfg "tmptest1.exe" - | AS_DLL -> + | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL -> // Compile as a DLL to exercise pickling of interface data, then recompile the original source file referencing this DLL // THe second compilation will not utilize the information from the first in any meaningful way, but the // compiler will unpickle the interface and optimization data, so we test unpickling as well. diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index d7561eef8a0..043d8d4b458 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -21,14 +21,15 @@ open FSharp.Test #if NETCOREAPP // Use these lines if you want to test CoreCLR -let FSC_BASIC = FSC_CORECLR -let FSC_BASIC_OPT_MINUS = FSC_CORECLR_OPT_MINUS -let FSC_BUILDONLY = FSC_CORECLR_BUILDONLY -let FSI_BASIC = FSI_CORECLR +let FSC_OPTIMIZED = FSC_NETCORE (true, false) +let FSC_DEBUG = FSC_NETCORE (false, false) +let FSC_BUILDONLY optimized = FSC_NETCORE (optimized, true) +let FSI = FSI_NETCORE #else -let FSC_BASIC = FSC_OPT_PLUS_DEBUG -let FSC_BASIC_OPT_MINUS = FSC_OPT_MINUS_DEBUG -let FSI_BASIC = FSI_FILE +let FSC_OPTIMIZED = FSC_NETFX (true, false) +let FSC_DEBUG = FSC_NETFX (false, false) +let FSC_BUILDONLY optimized = FSC_NETFX (optimized, true) +let FSI = FSI_NETFX #endif // ^^^^^^^^^^^^ To run these tests in F# Interactive , 'build net40', then send this chunk, then evaluate body of a test ^^^^^^^^^^^^ @@ -41,43 +42,43 @@ let testConfig = getTestsDirectory >> testConfig module CoreTests = // These tests are enabled for .NET Framework and .NET Core [] - let ``access-FSC_BASIC_OPT_MINUS``() = singleTestBuildAndRun "core/access" FSC_BASIC_OPT_MINUS + let ``access-FSC_DEBUG``() = singleTestBuildAndRun "core/access" FSC_DEBUG [] - let ``access-FSC_BASIC``() = singleTestBuildAndRun "core/access" FSC_BASIC + let ``access-FSC_OPTIMIZED``() = singleTestBuildAndRun "core/access" FSC_OPTIMIZED [] - let ``access-FSI_BASIC``() = singleTestBuildAndRun "core/access" FSI_BASIC + let ``access-FSI``() = singleTestBuildAndRun "core/access" FSI [] - let ``apporder-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC_OPT_MINUS + let ``apporder-FSC_DEBUG`` () = singleTestBuildAndRun "core/apporder" FSC_DEBUG [] - let ``apporder-FSC_BASIC`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC + let ``apporder-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/apporder" FSC_OPTIMIZED [] - let ``apporder-FSI_BASIC`` () = singleTestBuildAndRun "core/apporder" FSI_BASIC + let ``apporder-FSI`` () = singleTestBuildAndRun "core/apporder" FSI [] - let ``array-FSC_BASIC_OPT_MINUS-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC_OPT_MINUS "5.0" + let ``array-FSC_DEBUG-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_DEBUG "5.0" [] - let ``array-FSC_BASIC-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC "5.0" + let ``array-FSC_OPTIMIZED-5.0`` () = singleTestBuildAndRunVersion "core/array" FSC_OPTIMIZED "5.0" [] - let ``array-FSI_BASIC-5.0`` () = singleTestBuildAndRunVersion "core/array" FSI_BASIC "5.0" + let ``array-FSI-5.0`` () = singleTestBuildAndRunVersion "core/array" FSI "5.0" [] - let ``array-FSC_BASIC-preview`` () = singleTestBuildAndRunVersion "core/array" FSC_BASIC "preview" + let ``array-FSC_OPTIMIZED-preview`` () = singleTestBuildAndRunVersion "core/array" FSC_OPTIMIZED "preview" [] - let ``array-no-dot-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_BASIC_OPT_MINUS "preview" + let ``array-no-dot-FSC_DEBUG`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_DEBUG "preview" [] - let ``array-no-dot-FSC_BASIC`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_BASIC "preview" + let ``array-no-dot-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSC_OPTIMIZED "preview" [] - let ``array-no-dot-FSI_BASIC`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSI_BASIC "preview" + let ``array-no-dot-FSI`` () = singleTestBuildAndRunVersion "core/array-no-dot" FSI "preview" [] let ``array-no-dot-warnings-langversion-default`` () = @@ -100,12 +101,12 @@ module CoreTests = singleVersionedNegTest cfg "5.0" "test" [] - let ``auto-widen-version-FSC_BASIC_OPT_MINUS-preview``() = - singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_BASIC_OPT_MINUS "preview" + let ``auto-widen-version-FSC_DEBUG-preview``() = + singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_DEBUG "preview" [] - let ``auto-widen-version-FSC_BASIC-preview``() = - singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_BASIC "preview" + let ``auto-widen-version-FSC_OPTIMIZED-preview``() = + singleTestBuildAndRunVersion "core/auto-widen/preview" FSC_OPTIMIZED "preview" [] let ``auto-widen-version-preview-warns-on``() = @@ -120,283 +121,283 @@ module CoreTests = singleVersionedNegTest cfg "preview" "test" [] - let ``comprehensions-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/comprehensions" FSC_BASIC_OPT_MINUS + let ``comprehensions-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions" FSC_DEBUG [] - let ``comprehensions-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSC_BASIC + let ``comprehensions-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions" FSC_OPTIMIZED [] - let ``comprehensions-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSI_BASIC + let ``comprehensions-FSI`` () = singleTestBuildAndRun "core/comprehensions" FSI [] - let ``comprehensionshw-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_BASIC_OPT_MINUS + let ``comprehensionshw-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_DEBUG [] - let ``comprehensionshw-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_BASIC + let ``comprehensionshw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_OPTIMIZED [] - let ``comprehensionshw-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI_BASIC + let ``comprehensionshw-FSI`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI [] - let ``genericmeasures-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC_OPT_MINUS + let ``genericmeasures-FSC_DEBUG`` () = singleTestBuildAndRun "core/genericmeasures" FSC_DEBUG [] - let ``genericmeasures-FSC_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC + let ``genericmeasures-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/genericmeasures" FSC_OPTIMIZED [] - let ``genericmeasures-FSI_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSI_BASIC + let ``genericmeasures-FSI`` () = singleTestBuildAndRun "core/genericmeasures" FSI [] - let ``innerpoly-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/innerpoly" FSC_BASIC_OPT_MINUS + let ``innerpoly-FSC_DEBUG`` () = singleTestBuildAndRun "core/innerpoly" FSC_DEBUG [] - let ``innerpoly-FSC_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSC_BASIC + let ``innerpoly-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/innerpoly" FSC_OPTIMIZED [] - let ``innerpoly-FSI_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSI_BASIC + let ``innerpoly-FSI`` () = singleTestBuildAndRun "core/innerpoly" FSI [] - let ``namespaceAttributes-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/namespaces" FSC_BASIC_OPT_MINUS + let ``namespaceAttributes-FSC_DEBUG`` () = singleTestBuildAndRun "core/namespaces" FSC_DEBUG [] - let ``namespaceAttributes-FSC_BASIC`` () = singleTestBuildAndRun "core/namespaces" FSC_BASIC + let ``namespaceAttributes-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/namespaces" FSC_OPTIMIZED [] - let ``unicode2-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/unicode" FSC_BASIC_OPT_MINUS // TODO: fails on coreclr + let ``unicode2-FSC_DEBUG`` () = singleTestBuildAndRun "core/unicode" FSC_DEBUG // TODO: fails on coreclr [] - let ``unicode2-FSC_BASIC`` () = singleTestBuildAndRun "core/unicode" FSC_BASIC // TODO: fails on coreclr + let ``unicode2-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/unicode" FSC_OPTIMIZED // TODO: fails on coreclr [] - let ``unicode2-FSI_BASIC`` () = singleTestBuildAndRun "core/unicode" FSI_BASIC + let ``unicode2-FSI`` () = singleTestBuildAndRun "core/unicode" FSI [] - let ``lazy test-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/lazy" FSC_BASIC_OPT_MINUS + let ``lazy test-FSC_DEBUG`` () = singleTestBuildAndRun "core/lazy" FSC_DEBUG [] - let ``lazy test-FSC_BASIC`` () = singleTestBuildAndRun "core/lazy" FSC_BASIC + let ``lazy test-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/lazy" FSC_OPTIMIZED [] - let ``lazy test-FSI_BASIC`` () = singleTestBuildAndRun "core/lazy" FSI_BASIC + let ``lazy test-FSI`` () = singleTestBuildAndRun "core/lazy" FSI [] - let ``letrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec" FSC_BASIC_OPT_MINUS + let ``letrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec" FSC_DEBUG [] - let ``letrec-FSC_BASIC`` () = singleTestBuildAndRun "core/letrec" FSC_BASIC + let ``letrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec" FSC_OPTIMIZED [] - let ``letrec-FSI_BASIC`` () = singleTestBuildAndRun "core/letrec" FSI_BASIC + let ``letrec-FSI`` () = singleTestBuildAndRun "core/letrec" FSI [] - let ``letrec (mutrec variations part one) FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_BASIC_OPT_MINUS + let ``letrec (mutrec variations part one) FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_DEBUG [] - let ``letrec (mutrec variations part one) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_BASIC + let ``letrec (mutrec variations part one) FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_OPTIMIZED [] - let ``letrec (mutrec variations part one) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSI_BASIC + let ``letrec (mutrec variations part one) FSI`` () = singleTestBuildAndRun "core/letrec-mutrec" FSI [] - let ``libtest-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/libtest" FSC_BASIC_OPT_MINUS + let ``libtest-FSC_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_DEBUG [] - let ``libtest-FSC_BASIC`` () = singleTestBuildAndRun "core/libtest" FSC_BASIC + let ``libtest-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/libtest" FSC_OPTIMIZED [] - let ``libtest-FSI_BASIC`` () = singleTestBuildAndRun "core/libtest" FSI_BASIC + let ``libtest-FSI`` () = singleTestBuildAndRun "core/libtest" FSI [] - let ``lift-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/lift" FSC_BASIC_OPT_MINUS + let ``lift-FSC_DEBUG`` () = singleTestBuildAndRun "core/lift" FSC_DEBUG [] - let ``lift-FSC_BASIC`` () = singleTestBuildAndRun "core/lift" FSC_BASIC + let ``lift-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/lift" FSC_OPTIMIZED [] - let ``lift-FSI_BASIC`` () = singleTestBuildAndRun "core/lift" FSI_BASIC + let ``lift-FSI`` () = singleTestBuildAndRun "core/lift" FSI [] - let ``map-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/map" FSC_BASIC_OPT_MINUS + let ``map-FSC_DEBUG`` () = singleTestBuildAndRun "core/map" FSC_DEBUG [] - let ``map-FSC_BASIC`` () = singleTestBuildAndRun "core/map" FSC_BASIC + let ``map-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/map" FSC_OPTIMIZED [] - let ``map-FSI_BASIC`` () = singleTestBuildAndRun "core/map" FSI_BASIC + let ``map-FSI`` () = singleTestBuildAndRun "core/map" FSI [] - let ``measures-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/measures" FSC_BASIC_OPT_MINUS + let ``measures-FSC_DEBUG`` () = singleTestBuildAndRun "core/measures" FSC_DEBUG [] - let ``measures-FSC_BASIC`` () = singleTestBuildAndRun "core/measures" FSC_BASIC + let ``measures-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/measures" FSC_OPTIMIZED [] - let ``measures-FSI_BASIC`` () = singleTestBuildAndRun "core/measures" FSI_BASIC + let ``measures-FSI`` () = singleTestBuildAndRun "core/measures" FSI [] - let ``nested-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/nested" FSC_BASIC_OPT_MINUS + let ``nested-FSC_DEBUG`` () = singleTestBuildAndRun "core/nested" FSC_DEBUG [] - let ``nested-FSC_BASIC`` () = singleTestBuildAndRun "core/nested" FSC_BASIC + let ``nested-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/nested" FSC_OPTIMIZED [] - let ``nested-FSI_BASIC`` () = singleTestBuildAndRun "core/nested" FSI_BASIC + let ``nested-FSI`` () = singleTestBuildAndRun "core/nested" FSI [] - let ``members-ops-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ops" FSC_BASIC + let ``members-ops-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ops" FSC_OPTIMIZED [] - let ``members-ops-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ops" FSC_BASIC_OPT_MINUS + let ``members-ops-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ops" FSC_DEBUG [] - let ``members-ops-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ops" FSI_BASIC + let ``members-ops-FSI`` () = singleTestBuildAndRun "core/members/ops" FSI [] - let ``members-ops-mutrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_BASIC_OPT_MINUS + let ``members-ops-mutrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_DEBUG [] - let ``members-ops-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_BASIC + let ``members-ops-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_OPTIMIZED [] - let ``members-ops-mutrec-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSI_BASIC + let ``members-ops-mutrec-FSI`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSI [] - let ``seq-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/seq" FSC_BASIC_OPT_MINUS + let ``seq-FSC_DEBUG`` () = singleTestBuildAndRun "core/seq" FSC_DEBUG [] - let ``seq-FSC_BASIC`` () = singleTestBuildAndRun "core/seq" FSC_BASIC + let ``seq-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/seq" FSC_OPTIMIZED [] - let ``seq-FSI_BASIC`` () = singleTestBuildAndRun "core/seq" FSI_BASIC + let ``seq-FSI`` () = singleTestBuildAndRun "core/seq" FSI [] - let ``math-numbers-FSC_BASIC`` () = singleTestBuildAndRun "core/math/numbers" FSC_BASIC + let ``math-numbers-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/math/numbers" FSC_OPTIMIZED [] - let ``math-numbers-FSI_BASIC`` () = singleTestBuildAndRun "core/math/numbers" FSI_BASIC + let ``math-numbers-FSI`` () = singleTestBuildAndRun "core/math/numbers" FSI [] - let ``members-ctree-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/ctree" FSC_BASIC_OPT_MINUS + let ``members-ctree-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/ctree" FSC_DEBUG [] - let ``members-ctree-FSC_BASIC`` () = singleTestBuildAndRun "core/members/ctree" FSC_BASIC + let ``members-ctree-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/ctree" FSC_OPTIMIZED [] - let ``members-ctree-FSI_BASIC`` () = singleTestBuildAndRun "core/members/ctree" FSI_BASIC + let ``members-ctree-FSI`` () = singleTestBuildAndRun "core/members/ctree" FSI [] - let ``members-factors-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/factors" FSC_BASIC_OPT_MINUS + let ``members-factors-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/factors" FSC_DEBUG [] - let ``members-factors-FSC_BASIC`` () = singleTestBuildAndRun "core/members/factors" FSC_BASIC + let ``members-factors-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/factors" FSC_OPTIMIZED [] - let ``members-factors-FSI_BASIC`` () = singleTestBuildAndRun "core/members/factors" FSI_BASIC + let ``members-factors-FSI`` () = singleTestBuildAndRun "core/members/factors" FSI [] - let ``members-factors-mutrec-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_BASIC_OPT_MINUS + let ``members-factors-mutrec-FSC_DEBUG`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_DEBUG [] - let ``members-factors-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_BASIC + let ``members-factors-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_OPTIMIZED [] - let ``members-factors-mutrec-FSI_BASIC`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSI_BASIC + let ``members-factors-mutrec-FSI`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSI [] - let ``graph-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "perf/graph" FSC_BASIC_OPT_MINUS + let ``graph-FSC_DEBUG`` () = singleTestBuildAndRun "perf/graph" FSC_DEBUG [] - let ``graph-FSC_BASIC`` () = singleTestBuildAndRun "perf/graph" FSC_BASIC + let ``graph-FSC_OPTIMIZED`` () = singleTestBuildAndRun "perf/graph" FSC_OPTIMIZED [] - let ``graph-FSI_BASIC`` () = singleTestBuildAndRun "perf/graph" FSI_BASIC + let ``graph-FSI`` () = singleTestBuildAndRun "perf/graph" FSI [] - let ``nbody-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "perf/nbody" FSC_BASIC_OPT_MINUS + let ``nbody-FSC_DEBUG`` () = singleTestBuildAndRun "perf/nbody" FSC_DEBUG [] - let ``nbody-FSC_BASIC`` () = singleTestBuildAndRun "perf/nbody" FSC_BASIC + let ``nbody-FSC_OPTIMIZED`` () = singleTestBuildAndRun "perf/nbody" FSC_OPTIMIZED [] - let ``nbody-FSI_BASIC`` () = singleTestBuildAndRun "perf/nbody" FSI_BASIC + let ``nbody-FSI`` () = singleTestBuildAndRun "perf/nbody" FSI [] - let ``forexpression-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/forexpression" FSC_BASIC_OPT_MINUS + let ``forexpression-FSC_DEBUG`` () = singleTestBuildAndRun "core/forexpression" FSC_DEBUG [] - let ``forexpression-FSC_BASIC`` () = singleTestBuildAndRun "core/forexpression" FSC_BASIC + let ``forexpression-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/forexpression" FSC_OPTIMIZED [] - let ``forexpression-FSI_BASIC`` () = singleTestBuildAndRun "core/forexpression" FSI_BASIC + let ``forexpression-FSI`` () = singleTestBuildAndRun "core/forexpression" FSI [] - let ``letrec (mutrec variations part two) FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_BASIC_OPT_MINUS + let ``letrec (mutrec variations part two) FSC_DEBUG`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_DEBUG [] - let ``letrec (mutrec variations part two) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_BASIC + let ``letrec (mutrec variations part two) FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_OPTIMIZED [] - let ``letrec (mutrec variations part two) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSI_BASIC + let ``letrec (mutrec variations part two) FSI`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSI [] - let ``printf`` () = singleTestBuildAndRunVersion "core/printf" FSC_BASIC "preview" + let ``printf`` () = singleTestBuildAndRunVersion "core/printf" FSC_OPTIMIZED "preview" [] - let ``printf-interpolated`` () = singleTestBuildAndRunVersion "core/printf-interpolated" FSC_BASIC "preview" + let ``printf-interpolated`` () = singleTestBuildAndRunVersion "core/printf-interpolated" FSC_OPTIMIZED "preview" [] - let ``tlr-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/tlr" FSC_BASIC_OPT_MINUS + let ``tlr-FSC_DEBUG`` () = singleTestBuildAndRun "core/tlr" FSC_DEBUG [] - let ``tlr-FSC_BASIC`` () = singleTestBuildAndRun "core/tlr" FSC_BASIC + let ``tlr-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/tlr" FSC_OPTIMIZED [] - let ``tlr-FSI_BASIC`` () = singleTestBuildAndRun "core/tlr" FSI_BASIC + let ``tlr-FSI`` () = singleTestBuildAndRun "core/tlr" FSI [] - let ``subtype-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/subtype" FSC_BASIC_OPT_MINUS + let ``subtype-FSC_DEBUG`` () = singleTestBuildAndRun "core/subtype" FSC_DEBUG [] - let ``subtype-FSC_BASIC`` () = singleTestBuildAndRun "core/subtype" FSC_BASIC + let ``subtype-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/subtype" FSC_OPTIMIZED [] - let ``subtype-FSI_BASIC`` () = singleTestBuildAndRun "core/subtype" FSI_BASIC + let ``subtype-FSI`` () = singleTestBuildAndRun "core/subtype" FSI [] - let ``syntax-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/syntax" FSC_BASIC_OPT_MINUS + let ``syntax-FSC_DEBUG`` () = singleTestBuildAndRun "core/syntax" FSC_DEBUG [] - let ``syntax-FSC_BASIC`` () = singleTestBuildAndRun "core/syntax" FSC_BASIC + let ``syntax-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/syntax" FSC_OPTIMIZED [] - let ``syntax-FSI_BASIC`` () = singleTestBuildAndRun "core/syntax" FSI_BASIC + let ``syntax-FSI`` () = singleTestBuildAndRun "core/syntax" FSI [] - let ``test int32-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/int32" FSC_BASIC_OPT_MINUS + let ``test int32-FSC_DEBUG`` () = singleTestBuildAndRun "core/int32" FSC_DEBUG [] - let ``test int32-FSC_BASIC`` () = singleTestBuildAndRun "core/int32" FSC_BASIC + let ``test int32-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/int32" FSC_OPTIMIZED [] - let ``test int32-FSI_BASIC`` () = singleTestBuildAndRun "core/int32" FSI_BASIC + let ``test int32-FSI`` () = singleTestBuildAndRun "core/int32" FSI [] - let ``quotes-FSC-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/quotes" FSC_BASIC_OPT_MINUS + let ``quotes-FSC-FSC_DEBUG`` () = singleTestBuildAndRun "core/quotes" FSC_DEBUG [] - let ``quotes-FSC-BASIC`` () = singleTestBuildAndRun "core/quotes" FSC_BASIC + let ``quotes-FSC-BASIC`` () = singleTestBuildAndRun "core/quotes" FSC_OPTIMIZED [] - let ``quotes-FSI-BASIC`` () = singleTestBuildAndRun "core/quotes" FSI_BASIC + let ``quotes-FSI-BASIC`` () = singleTestBuildAndRun "core/quotes" FSI [] - let ``recordResolution-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/recordResolution" FSC_BASIC_OPT_MINUS + let ``recordResolution-FSC_DEBUG`` () = singleTestBuildAndRun "core/recordResolution" FSC_DEBUG [] - let ``recordResolution-FSC_BASIC`` () = singleTestBuildAndRun "core/recordResolution" FSC_BASIC + let ``recordResolution-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/recordResolution" FSC_OPTIMIZED [] - let ``recordResolution-FSI_BASIC`` () = singleTestBuildAndRun "core/recordResolution" FSI_BASIC + let ``recordResolution-FSI`` () = singleTestBuildAndRun "core/recordResolution" FSI [] let ``SDKTests`` () = @@ -405,10 +406,10 @@ module CoreTests = #if !NETCOREAPP [] - let ``attributes-FSC_BASIC`` () = singleTestBuildAndRun "core/attributes" FSC_BASIC + let ``attributes-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/attributes" FSC_OPTIMIZED [] - let ``attributes-FSI_BASIC`` () = singleTestBuildAndRun "core/attributes" FSI_BASIC + let ``attributes-FSI`` () = singleTestBuildAndRun "core/attributes" FSI [] let byrefs () = @@ -652,58 +653,58 @@ module CoreTests = #endif [] - let ``control-FSC_BASIC`` () = singleTestBuildAndRun "core/control" FSC_BASIC + let ``control-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/control" FSC_OPTIMIZED [] - let ``control-FSI_BASIC`` () = singleTestBuildAndRun "core/control" FSI_BASIC + let ``control-FSI`` () = singleTestBuildAndRun "core/control" FSI [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``controlChamenos-FSC_BASIC`` () = + let ``controlChamenos-FSC_OPTIMIZED`` () = let cfg = testConfig "core/controlChamenos" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``controlChamenos-FSI_BASIC`` () = + let ``controlChamenos-FSI`` () = let cfg = testConfig "core/controlChamenos" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSI_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSI [] - let ``controlMailbox-FSC_BASIC`` () = singleTestBuildAndRun "core/controlMailbox" FSC_BASIC + let ``controlMailbox-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/controlMailbox" FSC_OPTIMIZED [] - let ``controlMailbox-FSI_BASIC`` () = singleTestBuildAndRun "core/controlMailbox" FSI_BASIC + let ``controlMailbox-FSI`` () = singleTestBuildAndRun "core/controlMailbox" FSI [] let ``controlMailbox --tailcalls`` () = let cfg = testConfig "core/controlMailbox" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPTIMIZED [] - let ``csext-FSC_BASIC`` () = singleTestBuildAndRun "core/csext" FSC_BASIC + let ``csext-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/csext" FSC_OPTIMIZED [] - let ``csext-FSI_BASIC`` () = singleTestBuildAndRun "core/csext" FSI_BASIC + let ``csext-FSI`` () = singleTestBuildAndRun "core/csext" FSI [] - let ``enum-FSC_BASIC`` () = singleTestBuildAndRun "core/enum" FSC_BASIC + let ``enum-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/enum" FSC_OPTIMIZED [] - let ``enum-FSI_BASIC`` () = singleTestBuildAndRun "core/enum" FSI_BASIC + let ``enum-FSI`` () = singleTestBuildAndRun "core/enum" FSI #if !NETCOREAPP // Requires winforms will not run on coreclr [] - let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_BASIC + let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_OPTIMIZED // These tests are enabled for .NET Framework [] - let ``anon-FSC_BASIC``() = + let ``anon-FSC_OPTIMIZED``() = let cfg = testConfig "core/anon" fsc cfg "%s -a -o:lib.dll" cfg.fsc_flags ["lib.fs"] @@ -962,7 +963,7 @@ module CoreTests = testOkFile.CheckExists() [] - let ``genericmeasures-AS_DLL`` () = singleTestBuildAndRun "core/genericmeasures" AS_DLL + let ``genericmeasures-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/genericmeasures" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] @@ -982,7 +983,7 @@ module CoreTests = peverify cfg "client.exe" [] - let ``innerpoly-AS_DLL`` () = singleTestBuildAndRun "core/innerpoly" AS_DLL + let ``innerpoly-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/innerpoly" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] let queriesCustomQueryOps () = @@ -1355,13 +1356,13 @@ module CoreTests = exec cfg ("." ++ "test.exe") "" [] - let ``libtest-FSI_STDIN`` () = singleTestBuildAndRun "core/libtest" FSI_STDIN + let ``libtest-FSI_NETFX_STDIN`` () = singleTestBuildAndRun "core/libtest" FSI_NETFX_STDIN [] - let ``libtest-FSC_OPT_MINUS_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_OPT_MINUS_DEBUG + let ``libtest-unoptimized codegen`` () = singleTestBuildAndRun "core/libtest" FSC_DEBUG [] - let ``libtest-AS_DLL`` () = singleTestBuildAndRun "core/libtest" AS_DLL + let ``libtest-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/libtest" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] let ``no-warn-2003-tests`` () = @@ -1554,64 +1555,64 @@ module CoreTests = #endif [] - let ``longnames-FSC_BASIC`` () = singleTestBuildAndRun "core/longnames" FSC_BASIC + let ``longnames-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/longnames" FSC_OPTIMIZED [] - let ``longnames-FSI_BASIC`` () = singleTestBuildAndRun "core/longnames" FSI_BASIC + let ``longnames-FSI`` () = singleTestBuildAndRun "core/longnames" FSI [] - let ``math-numbersVS2008-FSC_BASIC`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_BASIC + let ``math-numbersVS2008-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_OPTIMIZED [] - let ``math-numbersVS2008-FSI_BASIC`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSI_BASIC + let ``math-numbersVS2008-FSI`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSI [] - let ``patterns-FSC_BASIC`` () = singleTestBuildAndRunVersion "core/patterns" FSC_BASIC "preview" + let ``patterns-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/patterns" FSC_OPTIMIZED "preview" //BUGBUG: https://github.com/Microsoft/visualfsharp/issues/6601 // [] -// let ``patterns-FSI_BASIC`` () = singleTestBuildAndRun' "core/patterns" FSI_BASIC +// let ``patterns-FSI`` () = singleTestBuildAndRun' "core/patterns" FSI [] - let ``pinvoke-FSC_BASIC`` () = singleTestBuildAndRun "core/pinvoke" FSC_BASIC + let ``pinvoke-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/pinvoke" FSC_OPTIMIZED [] - let ``pinvoke-FSI_BASIC`` () = - singleTestBuildAndRun "core/pinvoke" FSI_BASIC + let ``pinvoke-FSI`` () = + singleTestBuildAndRun "core/pinvoke" FSI [] - let ``fsi_load-FSC_BASIC`` () = singleTestBuildAndRun "core/fsi-load" FSC_BASIC + let ``fsi_load-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/fsi-load" FSC_OPTIMIZED [] - let ``fsi_load-FSI_BASIC`` () = singleTestBuildAndRun "core/fsi-load" FSI_BASIC + let ``fsi_load-FSI`` () = singleTestBuildAndRun "core/fsi-load" FSI #if !NETCOREAPP [] - let ``measures-AS_DLL`` () = singleTestBuildAndRun "core/measures" AS_DLL + let ``measures-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/measures" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] - let ``members-basics-AS_DLL`` () = singleTestBuildAndRun "core/members/basics" AS_DLL + let ``members-basics-FSC_NETFX_TEST_ROUNDTRIP_AS_DLL`` () = singleTestBuildAndRun "core/members/basics" FSC_NETFX_TEST_ROUNDTRIP_AS_DLL [] - let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_BASIC + let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_OPTIMIZED [] - let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_BASIC + let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_OPTIMIZED [] - let ``members-incremental-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental" FSC_BASIC + let ``members-incremental-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental" FSC_OPTIMIZED [] - let ``members-incremental-FSI_BASIC`` () = singleTestBuildAndRun "core/members/incremental" FSI_BASIC + let ``members-incremental-FSI`` () = singleTestBuildAndRun "core/members/incremental" FSI [] - let ``members-incremental-hw-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_BASIC + let ``members-incremental-hw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_OPTIMIZED [] - let ``members-incremental-hw-FSI_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw" FSI_BASIC + let ``members-incremental-hw-FSI`` () = singleTestBuildAndRun "core/members/incremental-hw" FSI [] - let ``members-incremental-hw-mutrec-FSC_BASIC`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_BASIC + let ``members-incremental-hw-mutrec-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_OPTIMIZED [] let queriesLeafExpressionConvert () = @@ -1811,10 +1812,10 @@ module CoreTests = #endif [] - let ``reflect-FSC_BASIC`` () = singleTestBuildAndRun "core/reflect" FSC_BASIC + let ``reflect-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/reflect" FSC_OPTIMIZED [] - let ``reflect-FSI_BASIC`` () = singleTestBuildAndRun "core/reflect" FSI_BASIC + let ``reflect-FSI`` () = singleTestBuildAndRun "core/reflect" FSI #if !NETCOREAPP [] @@ -2053,28 +2054,28 @@ module CoreTests = [] module VersionTests = [] - let ``member-selfidentifier-version4_6``() = singleTestBuildAndRunVersion "core/members/self-identifier/version46" FSC_BUILDONLY "4.6" + let ``member-selfidentifier-version4_6``() = singleTestBuildAndRunVersion "core/members/self-identifier/version46" (FSC_BUILDONLY true) "4.6" [] - let ``member-selfidentifier-version4_7``() = singleTestBuildAndRun "core/members/self-identifier/version47" FSC_BUILDONLY + let ``member-selfidentifier-version4_7``() = singleTestBuildAndRun "core/members/self-identifier/version47" (FSC_BUILDONLY true) [] - let ``indent-version4_6``() = singleTestBuildAndRunVersion "core/indent/version46" FSC_BUILDONLY "4.6" + let ``indent-version4_6``() = singleTestBuildAndRunVersion "core/indent/version46" (FSC_BUILDONLY true) "4.6" [] - let ``indent-version4_7``() = singleTestBuildAndRun "core/indent/version47" FSC_BUILDONLY + let ``indent-version4_7``() = singleTestBuildAndRun "core/indent/version47" (FSC_BUILDONLY true) [] - let ``nameof-version4_6``() = singleTestBuildAndRunVersion "core/nameof/version46" FSC_BUILDONLY "4.6" + let ``nameof-version4_6``() = singleTestBuildAndRunVersion "core/nameof/version46" (FSC_BUILDONLY true) "4.6" [] - let ``nameof-versionpreview``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_BUILDONLY "preview" + let ``nameof-versionpreview``() = singleTestBuildAndRunVersion "core/nameof/preview" (FSC_BUILDONLY true) "preview" [] - let ``nameof-execute``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_BASIC "preview" + let ``nameof-execute``() = singleTestBuildAndRunVersion "core/nameof/preview" FSC_OPTIMIZED "preview" [] - let ``nameof-fsi``() = singleTestBuildAndRunVersion "core/nameof/preview" FSI_BASIC "preview" + let ``nameof-fsi``() = singleTestBuildAndRunVersion "core/nameof/preview" FSI "preview" #if !NETCOREAPP [] @@ -2103,35 +2104,103 @@ module ToolsTests = #endif [] - let ``eval-FSC_BASIC`` () = singleTestBuildAndRun "tools/eval" FSC_BASIC + let ``eval-FSC_OPTIMIZED`` () = singleTestBuildAndRun "tools/eval" FSC_OPTIMIZED [] - let ``eval-FSI_BASIC`` () = singleTestBuildAndRun "tools/eval" FSI_BASIC + let ``eval-FSI`` () = singleTestBuildAndRun "tools/eval" FSI [] module RegressionTests = [] - let ``literal-value-bug-2-FSC_BASIC`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSC_BASIC + let ``literal-value-bug-2-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSC_OPTIMIZED [] - let ``literal-value-bug-2-FSI_BASIC`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSI_BASIC + let ``literal-value-bug-2-FSI`` () = singleTestBuildAndRun "regression/literal-value-bug-2" FSI [] - let ``OverloadResolution-bug-FSC_BASIC`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSC_BASIC + let ``OverloadResolution-bug-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSC_OPTIMIZED [] - let ``OverloadResolution-bug-FSI_BASIC`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSI_BASIC + let ``OverloadResolution-bug-FSI`` () = singleTestBuildAndRun "regression/OverloadResolution-bug" FSI [] - let ``struct-tuple-bug-1-FSC_BASIC`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSC_BASIC + let ``struct-tuple-bug-1-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSC_OPTIMIZED [] - let ``tuple-bug-1-FSC_BASIC`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_BASIC + let ``tuple-bug-1-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_OPTIMIZED [] - let ``12383-FSC_BASIC`` () = singleTestBuildAndRun "regression/12383" FSC_BASIC + let ``12383-FSC_OPTIMIZED`` () = singleTestBuildAndRun "regression/12383" FSC_OPTIMIZED + +#if NETCOREAPP + [] + let ``Large inputs 12322 fsc.dll 64-bit fsc.dll .NET SDK generating optimized code`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.dll 64-bit .NET SDK generating debug code`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + +#else + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating optimized code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating optimized code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating debug code portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``Large inputs 12322 fsc.exe 32-bit .NET Framework generating debug code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``Large inputs 12322 fscAnyCpu.exe 64-bit .NET Framework generating optimized code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``Large inputs 12322 fscAnyCpu.exe 64-bit .NET Framework generating optimized code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full " } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY true) + + [] + let ``12322 fscAnyCpu.exe 64-bit .NET Framework generating debug code, portable PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:portable --define:PORTABLE_PDB" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) + + [] + let ``12322 fscAnyCpu.exe 64-bit .NET Framework generating debug code, full PDB`` () = + let cfg = testConfig "regression/12322" + let cfg = { cfg with FSC = cfg.FSCANYCPU } + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --debug:full" } + singleTestBuildAndRunAux cfg (FSC_BUILDONLY false) +#endif #if !NETCOREAPP + [] let ``SRTP doesn't handle calling member hiding hinherited members`` () = let cfg = testConfig "regression/5531" @@ -2161,10 +2230,10 @@ module RegressionTests = #endif [] - let ``26`` () = singleTestBuildAndRun "regression/26" FSC_BASIC + let ``26`` () = singleTestBuildAndRun "regression/26" FSC_OPTIMIZED [] - let ``321`` () = singleTestBuildAndRun "regression/321" FSC_BASIC + let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPTIMIZED #if !NETCOREAPP // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 @@ -2199,10 +2268,10 @@ module RegressionTests = #if !NETCOREAPP // Requires WinForms [] - let ``83`` () = singleTestBuildAndRun "regression/83" FSC_BASIC + let ``83`` () = singleTestBuildAndRun "regression/83" FSC_OPTIMIZED [] - let ``84`` () = singleTestBuildAndRun "regression/84" FSC_BASIC + let ``84`` () = singleTestBuildAndRun "regression/84" FSC_OPTIMIZED [] let ``85`` () = @@ -2214,10 +2283,10 @@ module RegressionTests = #endif [] - let ``86`` () = singleTestBuildAndRun "regression/86" FSC_BASIC + let ``86`` () = singleTestBuildAndRun "regression/86" FSC_OPTIMIZED [] - let ``struct-tuple-bug-1-FSI_BASIC`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI_BASIC + let ``struct-tuple-bug-1-FSI`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI #if !NETCOREAPP // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 @@ -2368,10 +2437,10 @@ module TypecheckTests = [] let ``full-rank-arrays`` () = let cfg = testConfig "typecheck/full-rank-arrays" - SingleTest.singleTestBuildAndRunWithCopyDlls cfg "full-rank-arrays.dll" FSC_BASIC + SingleTest.singleTestBuildAndRunWithCopyDlls cfg "full-rank-arrays.dll" FSC_OPTIMIZED [] - let misc () = singleTestBuildAndRun "typecheck/misc" FSC_BASIC + let misc () = singleTestBuildAndRun "typecheck/misc" FSC_OPTIMIZED #if !NETCOREAPP @@ -3238,25 +3307,25 @@ namespace CST.RI.Anshun module GeneratedSignatureTests = [] - let ``libtest-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/libtest" GENERATED_SIGNATURE + let ``libtest-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/libtest" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``members-basics-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" GENERATED_SIGNATURE + let ``members-basics-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``access-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" GENERATED_SIGNATURE + let ``access-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``array-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" GENERATED_SIGNATURE + let ``array-FSC_NETFX_TEST_GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``genericmeasures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" GENERATED_SIGNATURE + let ``genericmeasures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``innerpoly-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" GENERATED_SIGNATURE + let ``innerpoly-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" FSC_NETFX_TEST_GENERATED_SIGNATURE [] - let ``measures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" GENERATED_SIGNATURE + let ``measures-FSC_NETFX_TEST_GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" FSC_NETFX_TEST_GENERATED_SIGNATURE #endif #if !NETCOREAPP