diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml
index cb67136ddce..0c5078f9f9c 100644
--- a/eng/Version.Details.xml
+++ b/eng/Version.Details.xml
@@ -3,9 +3,9 @@
-
+
https://github.com/dotnet/arcade
- ef3834feb8615429a58808cdcf9ad9284d767654
+ 0f5dd7680174620f31c9a00cdb2ac0b0e70e631f
diff --git a/global.json b/global.json
index 733aa27d45a..4c66387e58e 100644
--- a/global.json
+++ b/global.json
@@ -10,7 +10,7 @@
}
},
"msbuild-sdks": {
- "Microsoft.DotNet.Arcade.Sdk": "1.0.0-beta.19359.1",
+ "Microsoft.DotNet.Arcade.Sdk": "1.0.0-beta.19359.6",
"Microsoft.DotNet.Helix.Sdk": "2.0.0-beta.19069.2"
}
}
diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs
index 81f4db67748..290030d34e7 100644
--- a/src/fsharp/IlxGen.fs
+++ b/src/fsharp/IlxGen.fs
@@ -245,6 +245,12 @@ type cenv =
/// Used to apply forced inlining optimizations to witnesses generated late during codegen
mutable optimizeDuringCodeGen: (Expr -> Expr)
+
+ /// What depth are we at when generating an expression?
+ mutable exprRecursionDepth: int
+
+ /// Delayed Method Generation - prevents stack overflows when we need to generate methods that are split into many methods by the optimizer.
+ delayedGenMethods: Queue unit>
}
@@ -2137,20 +2143,53 @@ let DoesGenExprStartWithSequencePoint g sp expr =
FirstEmittedCodeWillBeSequencePoint g sp expr ||
EmitSequencePointForWholeExpr g sp expr
+let ProcessSequencePointForExpr (cenv: cenv) (cgbuf: CodeGenBuffer) sp expr =
+ let g = cenv.g
+ if not (FirstEmittedCodeWillBeSequencePoint g sp expr) then
+ if EmitSequencePointForWholeExpr g sp expr then
+ CG.EmitSeqPoint cgbuf (RangeOfSequencePointForWholeExpr g expr)
+ elif EmitHiddenCodeMarkerForWholeExpr g sp expr then
+ cgbuf.EmitStartOfHiddenCode()
+
//-------------------------------------------------------------------------
// Generate expressions
//-------------------------------------------------------------------------
-let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel =
+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
+
+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("Expression is too large and/or complex to emit.", expr.Range))
+
+and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel =
let g = cenv.g
let expr = stripExpr expr
- if not (FirstEmittedCodeWillBeSequencePoint g sp expr) then
- if EmitSequencePointForWholeExpr g sp expr then
- CG.EmitSeqPoint cgbuf (RangeOfSequencePointForWholeExpr g expr)
- elif EmitHiddenCodeMarkerForWholeExpr g sp expr then
- cgbuf.EmitStartOfHiddenCode()
+ ProcessSequencePointForExpr cenv cgbuf sp expr
+ // A sequence expression will always match Expr.App.
match (if compileSequenceExpressions then LowerCallsAndSeqs.LowerSeqExpr g cenv.amap expr else None) with
| Some info ->
GenSequenceExpr cenv cgbuf eenv info sequel
@@ -2161,32 +2200,8 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel =
GenConstant cenv cgbuf eenv (c, m, ty) sequel
| Expr.Match (spBind, exprm, tree, targets, m, ty) ->
GenMatch cenv cgbuf eenv (spBind, exprm, tree, targets, m, ty) sequel
- | Expr.Sequential (e1, e2, dir, spSeq, m) ->
- GenSequential cenv cgbuf eenv sp (e1, e2, dir, spSeq, m) sequel
| Expr.LetRec (binds, body, m, _) ->
GenLetRec cenv cgbuf eenv (binds, body, m) sequel
- | Expr.Let (bind, body, _, _) ->
- // This case implemented here to get a guaranteed tailcall
- // Make sure we generate the sequence point outside the scope of the variable
- let startScope, endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf
- let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind
- let spBind = GenSequencePointForBind cenv cgbuf bind
- GenBindingAfterSequencePoint cenv cgbuf eenv spBind bind (Some startScope)
-
- // Work out if we need a sequence point for the body. For any "user" binding then the body gets SPAlways.
- // For invisible compiler-generated bindings we just use "sp", unless its body is another invisible binding
- // For sticky bindings arising from inlining we suppress any immediate sequence point in the body
- let spBody =
- match bind.SequencePointInfo with
- | SequencePointAtBinding _
- | NoSequencePointAtLetBinding
- | NoSequencePointAtDoBinding -> SPAlways
- | NoSequencePointAtInvisibleBinding -> sp
- | NoSequencePointAtStickyBinding -> SPSuppress
-
- // Generate the body
- GenExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endScope))
-
| Expr.Lambda _ | Expr.TyLambda _ ->
GenLambda cenv cgbuf eenv false None expr sequel
| Expr.App (Expr.Val (vref, _, m) as v, _, tyargs, [], _) when
@@ -2207,8 +2222,10 @@ let rec GenExpr (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel =
// Most generation of linear expressions is implemented routinely using tailcalls and the correct sequels.
// This is because the element of expansion happens to be the final thing generated in most cases. However
// for large lists we have to process the linearity separately
+ | Expr.Sequential _
+ | Expr.Let _
| LinearOpExpr _ ->
- GenLinearExpr cenv cgbuf eenv expr sequel id |> ignore
+ GenLinearExpr cenv cgbuf eenv sp expr sequel (* canProcessSequencePoint *) false id |> ignore
| Expr.Op (op, tyargs, args, m) ->
match op, args, tyargs with
@@ -2522,16 +2539,63 @@ and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel =
GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,args.Length,m)
GenSequel cenv eenv.cloc cgbuf sequel
-and GenLinearExpr cenv cgbuf eenv expr sequel (contf: FakeUnit -> FakeUnit) =
- match expr with
- | LinearOpExpr (TOp.UnionCase c, tyargs, argsFront, argLast, m) ->
+and GenLinearExpr cenv cgbuf eenv sp expr sequel canProcessSequencePoint (contf: FakeUnit -> FakeUnit) =
+ match stripExpr expr with
+ | LinearOpExpr (TOp.UnionCase c, tyargs, argsFront, argLast, m) ->
GenExprs cenv cgbuf eenv argsFront
- GenLinearExpr cenv cgbuf eenv argLast Continue (contf << (fun Fake ->
+ GenLinearExpr cenv cgbuf eenv SPSuppress argLast Continue (* canProcessSequencePoint *) true (contf << (fun Fake ->
GenAllocUnionCaseCore cenv cgbuf eenv (c, tyargs, argsFront.Length + 1, m)
GenSequel cenv eenv.cloc cgbuf sequel
Fake))
+
+ | Expr.Sequential (e1, e2, specialSeqFlag, spSeq, _) ->
+ if canProcessSequencePoint then
+ ProcessSequencePointForExpr cenv cgbuf sp expr
+
+ // Compiler generated sequential executions result in suppressions of sequence points on both
+ // left and right of the sequence
+ let spAction, spExpr =
+ (match spSeq with
+ | SequencePointsAtSeq -> SPAlways, SPAlways
+ | SuppressSequencePointOnExprOfSequential -> SPSuppress, sp
+ | SuppressSequencePointOnStmtOfSequential -> sp, SPSuppress)
+ match specialSeqFlag with
+ | NormalSeq ->
+ GenExpr cenv cgbuf eenv spAction e1 discard
+ GenLinearExpr cenv cgbuf eenv spExpr e2 sequel (* canProcessSequencePoint *) true contf
+ | ThenDoSeq ->
+ GenExpr cenv cgbuf eenv spExpr e1 Continue
+ GenExpr cenv cgbuf eenv spAction e2 discard
+ GenSequel cenv eenv.cloc cgbuf sequel
+ contf Fake
+
+ | Expr.Let (bind, body, _, _) ->
+ if canProcessSequencePoint then
+ ProcessSequencePointForExpr cenv cgbuf sp expr
+
+ // This case implemented here to get a guaranteed tailcall
+ // Make sure we generate the sequence point outside the scope of the variable
+ let startScope, endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf
+ let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind
+ let spBind = GenSequencePointForBind cenv cgbuf bind
+ GenBindingAfterSequencePoint cenv cgbuf eenv spBind bind (Some startScope)
+
+ // Work out if we need a sequence point for the body. For any "user" binding then the body gets SPAlways.
+ // For invisible compiler-generated bindings we just use "sp", unless its body is another invisible binding
+ // For sticky bindings arising from inlining we suppress any immediate sequence point in the body
+ let spBody =
+ match bind.SequencePointInfo with
+ | SequencePointAtBinding _
+ | NoSequencePointAtLetBinding
+ | NoSequencePointAtDoBinding -> SPAlways
+ | NoSequencePointAtInvisibleBinding -> sp
+ | NoSequencePointAtStickyBinding -> SPSuppress
+
+ // Generate the body
+ GenLinearExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endScope)) (* canProcessSequencePoint *) true contf
+
| _ ->
- GenExpr cenv cgbuf eenv SPSuppress expr sequel
+ GenExpr cenv cgbuf eenv sp expr sequel
contf Fake
and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel =
@@ -3484,28 +3548,6 @@ and GenWhileLoop cenv cgbuf eenv (spWhile, e1, e2, m) sequel =
// SEQUENCE POINTS: Emit a sequence point to cover 'done' if present
GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel
-//--------------------------------------------------------------------------
-// Generate seq
-//--------------------------------------------------------------------------
-
-and GenSequential cenv cgbuf eenv spIn (e1, e2, specialSeqFlag, spSeq, _m) sequel =
-
- // Compiler generated sequential executions result in suppressions of sequence points on both
- // left and right of the sequence
- let spAction, spExpr =
- (match spSeq with
- | SequencePointsAtSeq -> SPAlways, SPAlways
- | SuppressSequencePointOnExprOfSequential -> SPSuppress, spIn
- | SuppressSequencePointOnStmtOfSequential -> spIn, SPSuppress)
- match specialSeqFlag with
- | NormalSeq ->
- GenExpr cenv cgbuf eenv spAction e1 discard
- GenExpr cenv cgbuf eenv spExpr e2 sequel
- | ThenDoSeq ->
- GenExpr cenv cgbuf eenv spExpr e1 Continue
- GenExpr cenv cgbuf eenv spAction e2 discard
- GenSequel cenv eenv.cloc cgbuf sequel
-
//--------------------------------------------------------------------------
// Generate IL assembly code.
// Polymorphic IL/ILX instructions may be instantiated when polymorphic code is inlined.
@@ -5220,7 +5262,14 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) s
let tps, ctorThisValOpt, baseValOpt, vsl, body', bodyty = IteratedAdjustArityOfLambda g cenv.amap topValInfo rhsExpr
let methodVars = List.concat vsl
CommitStartScope cgbuf startScopeMarkOpt
- GenMethodForBinding cenv cgbuf eenv (vspec, mspec, access, paramInfos, retInfo) (topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty)
+
+ let ilxMethInfoArgs =
+ (vspec, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty)
+ // if we have any expression recursion depth, we should delay the generation of a method to prevent stack overflows
+ if cenv.exprRecursionDepth > 0 then
+ DelayGenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs
+ else
+ GenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs
| StaticProperty (ilGetterMethSpec, optShadowLocal) ->
@@ -5659,11 +5708,10 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs =
let hasAggressiveInliningImplFlag = (implflags &&& 0x0100) <> 0x0
hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningImplFlag, hasAggressiveInliningImplFlag, attrs
-and GenMethodForBinding
- cenv cgbuf eenv
- (v: Val, mspec, access, paramInfos, retInfo)
- (topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body, returnTy) =
+and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs =
+ cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs)
+and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body, returnTy) =
let g = cenv.g
let m = v.Range
let selfMethodVars, nonSelfMethodVars, compileAsInstance =
@@ -5724,7 +5772,7 @@ and GenMethodForBinding
else
body
- let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
+ let ilCode = CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
// This is the main code generation for most methods
false, MethodBody.IL ilCode, false
@@ -5790,7 +5838,7 @@ and GenMethodForBinding
else
mdef
CountMethodDef()
- cgbuf.mgbuf.AddMethodDef(tref, mdef)
+ mgbuf.AddMethodDef(tref, mdef)
match v.MemberInfo with
@@ -5827,7 +5875,7 @@ and GenMethodForBinding
let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups
// fixup can potentially change name of reflected definition that was already recorded - patch it if necessary
- cgbuf.mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name)
+ mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name)
mdef
else
mkILGenericNonVirtualMethod (v.CompiledName g.CompilerGlobalState, access, ilMethTypars, ilParams, ilReturn, ilMethodBody)
@@ -5854,7 +5902,7 @@ and GenMethodForBinding
// Emit the pseudo-property as an event, but not if its a private method impl
if mdef.Access <> ILMemberAccess.Private then
let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy
- cgbuf.mgbuf.AddEventDef(tref, edef)
+ mgbuf.AddEventDef(tref, edef)
// The method def is dropped on the floor here
else
@@ -5864,7 +5912,7 @@ and GenMethodForBinding
let ilPropTy = GenType cenv.amap m eenvUnderMethTypeTypars.tyenv vtyp
let ilArgTys = v |> ArgInfosOfPropertyVal g |> List.map fst |> GenTypes cenv.amap m eenvUnderMethTypeTypars.tyenv
let ilPropDef = GenPropertyForMethodDef compileAsInstance tref mdef v memberInfo ilArgTys ilPropTy (mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) compiledName
- cgbuf.mgbuf.AddOrMergePropertyDef(tref, ilPropDef, m)
+ mgbuf.AddOrMergePropertyDef(tref, ilPropDef, m)
// Add the special name flag for all properties
let mdef = mdef.WithSpecialName.With(customAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated))
@@ -7676,7 +7724,9 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
casApplied = casApplied
intraAssemblyInfo = intraAssemblyInfo
opts = codeGenOpts
- optimizeDuringCodeGen = (fun x -> x) }
+ optimizeDuringCodeGen = (fun x -> x)
+ exprRecursionDepth = 0
+ delayedGenMethods = Queue () }
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/lib.fs b/src/fsharp/lib.fs
index bc6b4a77c0f..6c4599f8a1c 100755
--- a/src/fsharp/lib.fs
+++ b/src/fsharp/lib.fs
@@ -534,3 +534,14 @@ 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 ()
\ No newline at end of file
diff --git a/tests/fsharp/Compiler/CompilerAssert.fs b/tests/fsharp/Compiler/CompilerAssert.fs
index 2f3b600ff01..332ad59b8ae 100644
--- a/tests/fsharp/Compiler/CompilerAssert.fs
+++ b/tests/fsharp/Compiler/CompilerAssert.fs
@@ -12,6 +12,19 @@ open FSharp.Compiler.SourceCodeServices
open FSharp.Compiler.Interactive.Shell
open NUnit.Framework
+open System.Reflection.Emit
+
+[]
+type ILVerifier (dllFilePath: string) =
+
+ member this.VerifyIL (qualifiedItemName: string, expectedIL: string) =
+ ILChecker.checkILItem qualifiedItemName dllFilePath [ expectedIL ]
+
+ member this.VerifyIL (expectedIL: string list) =
+ ILChecker.checkIL dllFilePath expectedIL
+
+ member this.VerifyILWithLineNumbers (qualifiedItemName: string, expectedIL: string) =
+ ILChecker.checkILItemWithLineNumbers qualifiedItemName dllFilePath [ expectedIL ]
[]
module CompilerAssert =
@@ -47,11 +60,45 @@ module CompilerAssert =
ExtraProjectInfo = None
Stamp = None
}
-
- let lockObj = obj ()
+ let private gate = obj ()
+
+ let private compile isExe source f =
+ lock gate <| fun () ->
+ let inputFilePath = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
+ let outputFilePath = Path.ChangeExtension (Path.GetTempFileName(), if isExe then ".exe" else ".dll")
+ let runtimeConfigFilePath = Path.ChangeExtension (outputFilePath, ".runtimeconfig.json")
+ let fsCoreDllPath = config.FSCOREDLLPATH
+ let tmpFsCoreFilePath = Path.Combine (Path.GetDirectoryName(outputFilePath), Path.GetFileName(fsCoreDllPath))
+ try
+ File.Copy (fsCoreDllPath , tmpFsCoreFilePath, true)
+ File.WriteAllText (inputFilePath, source)
+ File.WriteAllText (runtimeConfigFilePath, """
+{
+ "runtimeOptions": {
+ "tfm": "netcoreapp2.1",
+ "framework": {
+ "name": "Microsoft.NETCore.App",
+ "version": "2.1.0"
+ }
+ }
+}
+ """)
+
+ let args =
+ defaultProjectOptions.OtherOptions
+ |> Array.append [| "fsc.exe"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |]
+ let errors, _ = checker.Compile args |> Async.RunSynchronously
+
+ f (errors, outputFilePath)
+
+ finally
+ try File.Delete inputFilePath with | _ -> ()
+ try File.Delete outputFilePath with | _ -> ()
+ try File.Delete runtimeConfigFilePath with | _ -> ()
+ try File.Delete tmpFsCoreFilePath with | _ -> ()
let Pass (source: string) =
- lock lockObj <| fun () ->
+ lock gate <| fun () ->
let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors)
@@ -64,7 +111,7 @@ module CompilerAssert =
let TypeCheckSingleError (source: string) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
- lock lockObj <| fun () ->
+ lock gate <| fun () ->
let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors)
@@ -82,8 +129,46 @@ module CompilerAssert =
Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg")
)
+ let CompileExe (source: string) =
+ compile true source (fun (errors, _) ->
+ if errors.Length > 0 then
+ Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors))
+
+ let CompileExeAndRun (source: string) =
+ compile true source (fun (errors, outputExe) ->
+
+ if errors.Length > 0 then
+ Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors)
+
+ let pInfo = ProcessStartInfo ()
+#if NETCOREAPP
+ pInfo.FileName <- config.DotNetExe
+ pInfo.Arguments <- outputExe
+#else
+ pInfo.FileName <- outputExe
+#endif
+
+ pInfo.RedirectStandardError <- true
+ pInfo.UseShellExecute <- false
+
+ let p = Process.Start(pInfo)
+
+ p.WaitForExit()
+ let errors = p.StandardError.ReadToEnd ()
+ if not (String.IsNullOrWhiteSpace errors) then
+ Assert.Fail errors
+ )
+
+ let CompileLibraryAndVerifyIL (source: string) (f: ILVerifier -> unit) =
+ compile false source (fun (errors, outputFilePath) ->
+ if errors.Length > 0 then
+ Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors)
+
+ f (ILVerifier outputFilePath)
+ )
+
let RunScript (source: string) (expectedErrorMessages: string list) =
- lock lockObj <| fun () ->
+ lock gate <| fun () ->
// Intialize output and input streams
use inStream = new StringReader("")
use outStream = new StringWriter()
diff --git a/tests/fsharp/Compiler/ILChecker.fs b/tests/fsharp/Compiler/ILChecker.fs
new file mode 100644
index 00000000000..200206f861f
--- /dev/null
+++ b/tests/fsharp/Compiler/ILChecker.fs
@@ -0,0 +1,97 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.UnitTests
+
+open System
+open System.IO
+open System.Diagnostics
+
+open NUnit.Framework
+open TestFramework
+
+[]
+module ILChecker =
+
+ let config = initializeSuite ()
+
+ let private exec exe args =
+ let startInfo = ProcessStartInfo(exe, String.concat " " args)
+ startInfo.RedirectStandardError <- true
+ startInfo.UseShellExecute <- false
+ use p = Process.Start(startInfo)
+ p.WaitForExit()
+ p.StandardError.ReadToEnd(), p.ExitCode
+
+ /// Filters i.e ['The system type \'System.ReadOnlySpan`1\' was required but no referenced system DLL contained this type']
+ let private filterSpecialComment (text: string) =
+ let pattern = @"(\[\'(.*?)\'\])"
+ System.Text.RegularExpressions.Regex.Replace(text, pattern,
+ (fun me -> String.Empty)
+ )
+
+ let private checkILAux ildasmArgs dllFilePath expectedIL =
+ let ilFilePath = Path.ChangeExtension(dllFilePath, ".il")
+
+ let mutable errorMsgOpt = None
+ try
+ let ildasmPath = config.ILDASM
+
+ exec ildasmPath (ildasmArgs @ [ sprintf "%s /out=%s" dllFilePath ilFilePath ]) |> ignore
+
+ let text = File.ReadAllText(ilFilePath)
+ let blockComments = @"/\*(.*?)\*/"
+ let lineComments = @"//(.*?)\r?\n"
+ let strings = @"""((\\[^\n]|[^""\n])*)"""
+ let verbatimStrings = @"@(""[^""]*"")+"
+ let textNoComments =
+ System.Text.RegularExpressions.Regex.Replace(text,
+ blockComments + "|" + lineComments + "|" + strings + "|" + verbatimStrings,
+ (fun me ->
+ if (me.Value.StartsWith("/*") || me.Value.StartsWith("//")) then
+ if me.Value.StartsWith("//") then Environment.NewLine else String.Empty
+ else
+ me.Value), System.Text.RegularExpressions.RegexOptions.Singleline)
+ |> filterSpecialComment
+
+ expectedIL
+ |> List.iter (fun (ilCode: string) ->
+ let expectedLines = ilCode.Split('\n')
+ let startIndex = textNoComments.IndexOf(expectedLines.[0])
+ if startIndex = -1 || textNoComments.Length < startIndex + ilCode.Length then
+ errorMsgOpt <- Some("==EXPECTED CONTAINS==\n" + ilCode + "\n")
+ else
+ let errors = ResizeArray()
+ let actualLines = textNoComments.Substring(startIndex, textNoComments.Length - startIndex).Split('\n')
+ for i = 0 to expectedLines.Length - 1 do
+ let expected = expectedLines.[i].Trim()
+ let actual = actualLines.[i].Trim()
+ if expected <> actual then
+ errors.Add(sprintf "\n==\nName: %s\n\nExpected:\t %s\nActual:\t\t %s\n==" actualLines.[0] expected actual)
+
+ if errors.Count > 0 then
+ let msg = String.concat "\n" errors + "\n\n\n==EXPECTED==\n" + ilCode + "\n"
+ errorMsgOpt <- Some(msg + "\n\n\n==ACTUAL==\n" + String.Join("\n", actualLines, 0, expectedLines.Length))
+ )
+
+ if expectedIL.Length = 0 then
+ errorMsgOpt <- Some ("No Expected IL")
+
+ match errorMsgOpt with
+ | Some(msg) -> errorMsgOpt <- Some(msg + "\n\n\n==ENTIRE ACTUAL==\n" + textNoComments)
+ | _ -> ()
+ finally
+ try File.Delete(ilFilePath) with | _ -> ()
+
+ match errorMsgOpt with
+ | Some(errorMsg) ->
+ Assert.Fail(errorMsg)
+ | _ -> ()
+
+ let checkILItem item dllFilePath expectedIL =
+ checkILAux [ sprintf "/item:%s" item ] dllFilePath expectedIL
+
+ let checkILItemWithLineNumbers item dllFilePath expectedIL =
+ checkILAux [ sprintf "/item:\"%s\"" item; "/linenum" ] dllFilePath expectedIL
+
+ let checkIL dllFilePath expectedIL =
+ checkILAux [] dllFilePath expectedIL
diff --git a/tests/fsharp/Compiler/ILHelpers.fs b/tests/fsharp/Compiler/ILHelpers.fs
deleted file mode 100644
index f31c4fdbbdf..00000000000
--- a/tests/fsharp/Compiler/ILHelpers.fs
+++ /dev/null
@@ -1,140 +0,0 @@
-// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
-
-namespace FSharp.Compiler.UnitTests
-
-open System
-open System.IO
-open System.Diagnostics
-
-open NUnit.Framework
-
-open FSharp.Compiler.SourceCodeServices
-
-open TestFramework
-
-[]
-module ILChecker =
-
- let checker = CompilerAssert.checker
-
- let config = initializeSuite ()
-
- let private exec exe args =
- let startInfo = ProcessStartInfo(exe, String.concat " " args)
- startInfo.RedirectStandardError <- true
- startInfo.UseShellExecute <- false
- use p = Process.Start(startInfo)
- p.WaitForExit()
- p.StandardError.ReadToEnd(), p.ExitCode
-
- /// Filters i.e ['The system type \'System.ReadOnlySpan`1\' was required but no referenced system DLL contained this type']
- let private filterSpecialComment (text: string) =
- let pattern = @"(\[\'(.*?)\'\])"
- System.Text.RegularExpressions.Regex.Replace(text, pattern,
- (fun me -> String.Empty)
- )
-
- let private checkAux extraDlls source expectedIL =
- let tmp = Path.GetTempFileName()
- let tmpFs = Path.ChangeExtension(tmp, ".fs")
- let tmpDll = Path.ChangeExtension(tmp, ".dll")
- let tmpIL = Path.ChangeExtension(tmp, ".il")
-
- let mutable errorMsgOpt = None
- try
- let ildasmPath = config.ILDASM
-
- File.WriteAllText(tmpFs, source)
-
- let extraReferences = extraDlls |> Array.ofList |> Array.map (fun reference -> "-r:" + reference)
-
-#if NETCOREAPP
- // Hack: Currently a hack to get the runtime assemblies for netcore in order to compile.
- let runtimeAssemblies =
- typeof.Assembly.Location
- |> Path.GetDirectoryName
- |> Directory.EnumerateFiles
- |> Seq.toArray
- |> Array.filter (fun x -> x.ToLowerInvariant().Contains("system."))
- |> Array.map (fun x -> sprintf "-r:%s" x)
-
- let extraReferences = Array.append runtimeAssemblies extraReferences
-
- let errors, exitCode = checker.Compile(Array.append [| "fsc.exe"; "--optimize+"; "-o"; tmpDll; "-a"; tmpFs; "--targetprofile:netcore"; "--noframework" |] extraReferences) |> Async.RunSynchronously
-#else
- let errors, exitCode = checker.Compile(Array.append [| "fsc.exe"; "--optimize+"; "-o"; tmpDll; "-a"; tmpFs |] extraReferences) |> Async.RunSynchronously
-#endif
- let errors =
- String.concat "\n" (errors |> Array.map (fun x -> x.Message))
-
- if exitCode = 0 then
- exec ildasmPath [ sprintf "%s /out=%s" tmpDll tmpIL ] |> ignore
-
- let text = File.ReadAllText(tmpIL)
- let blockComments = @"/\*(.*?)\*/"
- let lineComments = @"//(.*?)\r?\n"
- let strings = @"""((\\[^\n]|[^""\n])*)"""
- let verbatimStrings = @"@(""[^""]*"")+"
- let textNoComments =
- System.Text.RegularExpressions.Regex.Replace(text,
- blockComments + "|" + lineComments + "|" + strings + "|" + verbatimStrings,
- (fun me ->
- if (me.Value.StartsWith("/*") || me.Value.StartsWith("//")) then
- if me.Value.StartsWith("//") then Environment.NewLine else String.Empty
- else
- me.Value), System.Text.RegularExpressions.RegexOptions.Singleline)
- |> filterSpecialComment
-
- expectedIL
- |> List.iter (fun (ilCode: string) ->
- let expectedLines = ilCode.Split('\n')
- let startIndex = textNoComments.IndexOf(expectedLines.[0])
- if startIndex = -1 || textNoComments.Length < startIndex + ilCode.Length then
- errorMsgOpt <- Some("==EXPECTED CONTAINS==\n" + ilCode + "\n")
- else
- let errors = ResizeArray()
- let actualLines = textNoComments.Substring(startIndex, textNoComments.Length - startIndex).Split('\n')
- for i = 0 to expectedLines.Length - 1 do
- let expected = expectedLines.[i].Trim()
- let actual = actualLines.[i].Trim()
- if expected <> actual then
- errors.Add(sprintf "\n==\nName: %s\n\nExpected:\t %s\nActual:\t\t %s\n==" actualLines.[0] expected actual)
-
- if errors.Count > 0 then
- let msg = String.concat "\n" errors + "\n\n\n==EXPECTED==\n" + ilCode + "\n"
- errorMsgOpt <- Some(msg + "\n\n\n==ACTUAL==\n" + String.Join("\n", actualLines, 0, expectedLines.Length))
- )
-
- if expectedIL.Length = 0 then
- errorMsgOpt <- Some ("No Expected IL")
-
- match errorMsgOpt with
- | Some(msg) -> errorMsgOpt <- Some(msg + "\n\n\n==ENTIRE ACTUAL==\n" + textNoComments)
- | _ -> ()
- else
- errorMsgOpt <- Some(errors)
- finally
- try File.Delete(tmp) with | _ -> ()
- try File.Delete(tmpFs) with | _ -> ()
- try File.Delete(tmpDll) with | _ -> ()
- try File.Delete(tmpIL) with | _ -> ()
-
- match errorMsgOpt with
- | Some(errorMsg) ->
- Assert.Fail(errorMsg)
- | _ -> ()
-
- let getPackageDlls name version framework dllNames =
- dllNames
- |> List.map (fun dllName ->
- requireFile (packagesDir ++ name ++ version ++ "lib" ++ framework ++ dllName)
- )
-
- /// Compile the source and check to see if the expected IL exists.
- /// The first line of each expected IL string is found first.
- let check source expectedIL =
- checkAux [] source expectedIL
-
- let checkWithDlls extraDlls source expectedIL =
- checkAux extraDlls source expectedIL
-
diff --git a/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs b/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs
index b6f5ce9d952..efcea68afd3 100644
--- a/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs
+++ b/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs
@@ -4,7 +4,7 @@ namespace FSharp.Compiler.UnitTests
open NUnit.Framework
-#if !NETCOREAPP
+#if NETCOREAPP
[]
module SpanOptimizationTests =
@@ -22,24 +22,24 @@ let test () =
Console.WriteLine(item)
"""
- ILChecker.checkWithDlls
- (ILChecker.getPackageDlls "System.Memory" "4.5.2" "netstandard2.0" [ "System.Memory.dll" ])
- source
- [
- """.method public static void test() cil managed
+ CompilerAssert.CompileLibraryAndVerifyIL source
+ (fun verifier ->
+ verifier.VerifyIL
+ [
+ """.method public static void test() cil managed
{
.maxstack 5
- .locals init (valuetype [System.Memory]System.Span`1