diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 62528b1da7f..bef9cac0bc2 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -1757,11 +1757,14 @@ let isStructRecordOrUnionTyconTy g ty = | ValueSome tcref -> tcref.Deref.IsStructRecordOrUnionTycon | _ -> false +let isStructTyconRef (tcref: TyconRef) = + let tycon = tcref.Deref + tycon.IsStructRecordOrUnionTycon || tycon.IsStructOrEnumTycon + let isStructTy g ty = match tryDestAppTy g ty with | ValueSome tcref -> - let tycon = tcref.Deref - tycon.IsStructRecordOrUnionTycon || tycon.IsStructOrEnumTycon + isStructTyconRef tcref | _ -> isStructAnonRecdTy g ty || isStructTupleTy g ty @@ -3014,7 +3017,7 @@ let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) = | None -> let res = isByrefTyconRef g tcref || - TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref + (isStructTyconRef tcref && TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref) tcref.SetIsByRefLike res res @@ -3023,11 +3026,45 @@ let isSpanLikeTyconRef g m tcref = not (isByrefTyconRef g tcref) let isByrefLikeTy g m ty = - ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) + ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) let isSpanLikeTy g m ty = isByrefLikeTy g m ty && - not (isByrefTy g ty) + not (isByrefTy g ty) + +let isSpanTyconRef g m tcref = + isByrefLikeTyconRef g m tcref && + tcref.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Span`1" + +let isSpanTy g m ty = + ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isSpanTyconRef g m tcref | _ -> false) + +let rec tryDestSpanTy g m ty = + match tryAppTy g ty with + | ValueSome(tcref, [ty]) when isSpanTyconRef g m tcref -> ValueSome(struct(tcref, ty)) + | _ -> ValueNone + +let destSpanTy g m ty = + match tryDestSpanTy g m ty with + | ValueSome(struct(tcref, ty)) -> struct(tcref, ty) + | _ -> failwith "destSpanTy" + +let isReadOnlySpanTyconRef g m tcref = + isByrefLikeTyconRef g m tcref && + tcref.CompiledRepresentationForNamedType.BasicQualifiedName = "System.ReadOnlySpan`1" + +let isReadOnlySpanTy g m ty = + ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isReadOnlySpanTyconRef g m tcref | _ -> false) + +let tryDestReadOnlySpanTy g m ty = + match tryAppTy g ty with + | ValueSome(tcref, [ty]) when isReadOnlySpanTyconRef g m tcref -> ValueSome(struct(tcref, ty)) + | _ -> ValueNone + +let destReadOnlySpanTy g m ty = + match tryDestReadOnlySpanTy g m ty with + | ValueSome(struct(tcref, ty)) -> struct(tcref, ty) + | _ -> failwith "destReadOnlySpanTy" //------------------------------------------------------------------------- // List and reference types... diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index 6098625122f..3a414249059 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -2078,6 +2078,18 @@ val isByrefLikeTy : TcGlobals -> range -> TType -> bool /// Check if the type is a byref-like but not a byref. val isSpanLikeTy : TcGlobals -> range -> TType -> bool +val isSpanTy : TcGlobals -> range -> TType -> bool + +val tryDestSpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) voption + +val destSpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) + +val isReadOnlySpanTy : TcGlobals -> range -> TType -> bool + +val tryDestReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) voption + +val destReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) + //------------------------------------------------------------------------- // Tuple constructors/destructors //------------------------------------------------------------------------- diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 86cea705baf..aa9a052ed63 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -458,7 +458,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_struct_tuple5_tcr = findSysTyconRef sys "ValueTuple`5" let v_struct_tuple6_tcr = findSysTyconRef sys "ValueTuple`6" let v_struct_tuple7_tcr = findSysTyconRef sys "ValueTuple`7" - let v_struct_tuple8_tcr = findSysTyconRef sys "ValueTuple`8" + let v_struct_tuple8_tcr = findSysTyconRef sys "ValueTuple`8" let v_choice2_tcr = mk_MFCore_tcref fslibCcu "Choice`2" let v_choice3_tcr = mk_MFCore_tcref fslibCcu "Choice`3" @@ -728,7 +728,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_fail_static_init_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "FailStaticInit" , None , None , [], ([[v_unit_ty]], v_unit_ty)) let v_check_this_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CheckThis" , None , None , [vara], ([[varaTy]], varaTy)) let v_quote_to_linq_lambda_info = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref, "QuotationToLambdaExpression" , None , None , [vara], ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy)) - + let tref_DebuggableAttribute = findSysILTypeRef tname_DebuggableAttribute let tref_CompilerGeneratedAttribute = findSysILTypeRef tname_CompilerGeneratedAttribute diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 48c3ea31ebd..ba15bf72318 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3043,6 +3043,24 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF let TryFindIntrinsicOrExtensionMethInfo (cenv: cenv) (env: TcEnv) m ad nm ty = AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some(nm), ad) IgnoreOverrides m ty +let TryFindFSharpSignatureInstanceGetterProperty (cenv: cenv) (env: TcEnv) m nm ty (sigTys: TType list) = + TryFindPropInfo cenv.infoReader m env.AccessRights nm ty + |> List.tryFind (fun propInfo -> + not propInfo.IsStatic && propInfo.HasGetter && + ( + match propInfo.GetterMethod.GetParamTypes(cenv.amap, m, []) with + | [] -> false + | argTysList -> + + let argTys = (argTysList |> List.reduce (@)) @ [ propInfo.GetterMethod.GetFSharpReturnTy(cenv.amap, m, []) ] in + if argTys.Length <> sigTys.Length then + false + else + (argTys, sigTys) + ||> List.forall2 (typeEquiv cenv.g) + ) + ) + /// Build the 'test and dispose' part of a 'use' statement let BuildDisposableCleanup cenv env m (v: Val) = v.SetHasBeenReferenced() @@ -7112,6 +7130,25 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWholeExpr, spForLoop) = + let tryGetOptimizeSpanMethodsAux g m ty isReadOnlySpan = + match (if isReadOnlySpan then tryDestReadOnlySpanTy g m ty else tryDestSpanTy g m ty) with + | ValueSome(struct(_, destTy)) -> + match TryFindFSharpSignatureInstanceGetterProperty cenv env m "Item" ty [ g.int32_ty; (if isReadOnlySpan then mkInByrefTy g destTy else mkByrefTy g destTy) ], + TryFindFSharpSignatureInstanceGetterProperty cenv env m "Length" ty [ g.int32_ty ] with + | Some(itemPropInfo), Some(lengthPropInfo) -> + ValueSome(struct(itemPropInfo.GetterMethod, lengthPropInfo.GetterMethod, isReadOnlySpan)) + | _ -> + ValueNone + | _ -> + ValueNone + + let tryGetOptimizeSpanMethods g m ty = + let result = tryGetOptimizeSpanMethodsAux g m ty false + if result.IsSome then + result + else + tryGetOptimizeSpanMethodsAux g m ty true + UnifyTypes cenv env mWholeExpr overallTy cenv.g.unit_ty let mPat = pat.Range @@ -7136,7 +7173,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol let arrVar, arrExpr = mkCompGenLocal mEnumExpr "arr" enumExprTy let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty let elemTy = destArrayTy cenv.g enumExprTy - + // Evaluate the array index lookup let bodyExprFixup elemVar bodyExpr = mkCompGenLet mForLoopStart elemVar (mkLdelem cenv.g mForLoopStart elemTy arrExpr idxExpr) bodyExpr @@ -7145,13 +7182,37 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol // Ask for a loop over integers for the given range (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero cenv.g mForLoopStart, mkDecr cenv.g mForLoopStart (mkLdlen cenv.g mForLoopStart arrExpr))) - + | _ -> + // try optimize 'for i in span do' for span or readonlyspan + match tryGetOptimizeSpanMethods cenv.g mWholeExpr enumExprTy with + | ValueSome(struct(getItemMethInfo, getLengthMethInfo, isReadOnlySpan)) -> + let tcVal = LightweightTcValForUsingInBuildMethodCall cenv.g + let spanVar, spanExpr = mkCompGenLocal mEnumExpr "span" enumExprTy + let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty + let struct(_, elemTy) = if isReadOnlySpan then destReadOnlySpanTy cenv.g mWholeExpr enumExprTy else destSpanTy cenv.g mWholeExpr enumExprTy + let elemAddrTy = if isReadOnlySpan then mkInByrefTy cenv.g elemTy else mkByrefTy cenv.g elemTy + + // Evaluate the span index lookup + let bodyExprFixup elemVar bodyExpr = + let elemAddrVar, _ = mkCompGenLocal mForLoopStart "addr" elemAddrTy + let e = mkCompGenLet mForLoopStart elemVar (mkAddrGet mForLoopStart (mkLocalValRef elemAddrVar)) bodyExpr + let getItemCallExpr, _ = BuildMethodCall tcVal cenv.g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ] + mkCompGenLet mForLoopStart elemAddrVar getItemCallExpr e + + // Evaluate the span expression once and put it in spanVar + let overallExprFixup overallExpr = mkCompGenLet mForLoopStart spanVar enumExpr overallExpr + + let getLengthCallExpr, _ = BuildMethodCall tcVal cenv.g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] + + // Ask for a loop over integers for the given range + (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero cenv.g mForLoopStart, mkDecr cenv.g mForLoopStart getLengthCallExpr)) - let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy - let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr = - AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar - (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr)) + | _ -> + let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy + let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr = + AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar + (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr)) let pat, _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat, None) let elemVar, pat = diff --git a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj index 97ac752e376..7262d2fd895 100644 --- a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj +++ b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj @@ -17,11 +17,6 @@ - - - - - diff --git a/tests/FSharp.Compiler.UnitTests/Compiler.fs b/tests/fsharp/Compiler/CompilerAssert.fs similarity index 50% rename from tests/FSharp.Compiler.UnitTests/Compiler.fs rename to tests/fsharp/Compiler/CompilerAssert.fs index d85aef5b404..75874b41baa 100644 --- a/tests/FSharp.Compiler.UnitTests/Compiler.fs +++ b/tests/fsharp/Compiler/CompilerAssert.fs @@ -3,22 +3,41 @@ namespace FSharp.Compiler.UnitTests open System +open System.IO +open System.Text +open System.Diagnostics open FSharp.Compiler.Text open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Interactive.Shell open NUnit.Framework [] -module Compiler = +module CompilerAssert = let checker = FSharpChecker.Create() + let private config = TestFramework.initializeSuite () + let private defaultProjectOptions = { ProjectFileName = "Z:\\test.fsproj" ProjectId = None SourceFiles = [|"test.fs"|] +#if !NETCOREAPP OtherOptions = [||] +#else + OtherOptions = + // Hack: Currently a hack to get the runtime assemblies for netcore in order to compile. + let assemblies = + 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) + Array.append [|"--targetprofile:netcore"; "--noframework"|] assemblies +#endif ReferencedProjects = [||] IsIncompleteTypeCheckEnvironment = false UseScriptResolutionRules = false @@ -29,7 +48,7 @@ module Compiler = Stamp = None } - let AssertPass (source: string) = + let Pass (source: string) = let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously Assert.True(parseResults.Errors.Length = 0, sprintf "Parse errors: %A" parseResults.Errors) @@ -40,7 +59,7 @@ module Compiler = Assert.True(typeCheckResults.Errors.Length = 0, sprintf "Type Check errors: %A" typeCheckResults.Errors) - let AssertSingleErrorTypeCheck (source: string) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = + let TypeCheckSingleError (source: string) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously Assert.True(parseResults.Errors.Length = 0, sprintf "Parse errors: %A" parseResults.Errors) @@ -56,4 +75,40 @@ module Compiler = Assert.AreEqual(expectedErrorNumber, info.ErrorNumber, "expectedErrorNumber") Assert.AreEqual(expectedErrorRange, (info.StartLineAlternate, info.StartColumn, info.EndLineAlternate, info.EndColumn), "expectedErrorRange") Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg") - ) \ No newline at end of file + ) + + let RunScript (source: string) (expectedErrorMessages: string list) = + // Intialize output and input streams + use inStream = new StringReader("") + use outStream = new StringWriter() + use errStream = new StringWriter() + + // Build command line arguments & start FSI session + let argv = [| "C:\\fsi.exe" |] +#if !NETCOREAPP + let allArgs = Array.append argv [|"--noninteractive"|] +#else + let allArgs = Array.append argv [|"--noninteractive"; "--targetprofile:netcore"|] +#endif + + let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration() + use fsiSession = FsiEvaluationSession.Create(fsiConfig, allArgs, inStream, outStream, errStream, collectible = true) + + let ch, errors = fsiSession.EvalInteractionNonThrowing source + + let errorMessages = ResizeArray() + errors + |> Seq.iter (fun error -> errorMessages.Add(error.Message)) + + match ch with + | Choice2Of2 ex -> errorMessages.Add(ex.Message) + | _ -> () + + if expectedErrorMessages.Length <> errorMessages.Count then + Assert.Fail(sprintf "Expected error messages: %A \n\n Actual error messages: %A" expectedErrorMessages errorMessages) + else + (expectedErrorMessages, errorMessages) + ||> Seq.iter2 (fun expectedErrorMessage errorMessage -> + Assert.AreEqual(expectedErrorMessage, errorMessage) + ) + \ No newline at end of file diff --git a/tests/FSharp.Compiler.UnitTests/ILHelpers.fs b/tests/fsharp/Compiler/ILHelpers.fs similarity index 65% rename from tests/FSharp.Compiler.UnitTests/ILHelpers.fs rename to tests/fsharp/Compiler/ILHelpers.fs index 06c3794f74b..f31c4fdbbdf 100644 --- a/tests/FSharp.Compiler.UnitTests/ILHelpers.fs +++ b/tests/fsharp/Compiler/ILHelpers.fs @@ -10,24 +10,14 @@ open NUnit.Framework open FSharp.Compiler.SourceCodeServices +open TestFramework + [] module ILChecker = - let checker = Compiler.checker - - let private (++) a b = Path.Combine(a,b) - - let private getfullpath workDir (path: string) = - let rooted = - if Path.IsPathRooted(path) then path - else Path.Combine(workDir, path) - rooted |> Path.GetFullPath + let checker = CompilerAssert.checker - let private fileExists workDir path = - if path |> getfullpath workDir |> File.Exists then Some path else None - - let private requireFile nm = - if fileExists __SOURCE_DIRECTORY__ nm |> Option.isSome then nm else failwith (sprintf "couldn't find %s. Running 'build test' once might solve this issue" nm) + let config = initializeSuite () let private exec exe args = let startInfo = ProcessStartInfo(exe, String.concat " " args) @@ -37,22 +27,14 @@ module ILChecker = p.WaitForExit() p.StandardError.ReadToEnd(), p.ExitCode - /// 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 = - let packagesDir = - // On Unix the user profile directory is in the variable HOME - // On windows it's called USERPROFILE - let userProfile = - let profile = Environment.GetEnvironmentVariable("USERPROFILE") - if not (String.IsNullOrEmpty(profile)) then profile - else Environment.GetEnvironmentVariable("HOME") - userProfile ++ ".nuget" ++ "packages" - let Is64BitOperatingSystem = sizeof = 8 - let architectureMoniker = if Is64BitOperatingSystem then "x64" else "x86" - let ildasmExe = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.ILDAsm") ++ "2.0.3" ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "ildasm.exe") - let coreclrDll = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.Runtime.CoreCLR") ++ "2.0.3" ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "coreclr.dll") + /// 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") @@ -60,17 +42,33 @@ module ILChecker = let mutable errorMsgOpt = None try - // ildasm requires coreclr.dll to run which has already been restored to the packages directory - File.Copy(coreclrDll, Path.GetDirectoryName(ildasmExe) ++ "coreclr.dll", overwrite=true) + let ildasmPath = config.ILDASM File.WriteAllText(tmpFs, source) - let errors, exitCode = checker.Compile([| "fsc.exe"; "--optimize+"; "-o"; tmpDll; "-a"; tmpFs |]) |> Async.RunSynchronously + 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 ildasmExe [ sprintf "%s /out=%s" tmpDll tmpIL ] |> ignore + exec ildasmPath [ sprintf "%s /out=%s" tmpDll tmpIL ] |> ignore let text = File.ReadAllText(tmpIL) let blockComments = @"/\*(.*?)\*/" @@ -85,6 +83,7 @@ module ILChecker = 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) -> @@ -106,6 +105,9 @@ module ILChecker = 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) | _ -> () @@ -121,4 +123,18 @@ module ILChecker = | 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.UnitTests/Language/AnonRecords.fs b/tests/fsharp/Compiler/Language/AnonRecordTests.fs similarity index 71% rename from tests/FSharp.Compiler.UnitTests/Language/AnonRecords.fs rename to tests/fsharp/Compiler/Language/AnonRecordTests.fs index 21c48417442..7182e359b19 100644 --- a/tests/FSharp.Compiler.UnitTests/Language/AnonRecords.fs +++ b/tests/fsharp/Compiler/Language/AnonRecordTests.fs @@ -5,51 +5,42 @@ namespace FSharp.Compiler.UnitTests open NUnit.Framework [] -module AnonRecords = +module AnonRecordsTests = -#if !NETCOREAPP [] -#endif let NotStructConstraintPass() = - Compiler.AssertPass + CompilerAssert.Pass """ type RefClass<'a when 'a : not struct>() = class end let rAnon = RefClass<{| R: int |}>() """ -#if !NETCOREAPP [] -#endif let StructConstraintPass() = - Compiler.AssertPass + CompilerAssert.Pass """ type StructClass<'a when 'a : struct>() = class end let sAnon = StructClass() """ -#if !NETCOREAPP [] -#endif let NotStructConstraintFail() = - Compiler.AssertSingleErrorTypeCheck + CompilerAssert.TypeCheckSingleError """ - type RefClass<'a when 'a : not struct>() = class end - let rAnon = RefClass() +type RefClass<'a when 'a : not struct>() = class end +let rAnon = RefClass() """ 1 - (3, 16, 3, 45) + (3, 12, 3, 41) "A generic construct requires that the type 'struct {|R : int|}' have reference semantics, but it does not, i.e. it is a struct" -#if !NETCOREAPP [] -#endif let StructConstraintFail() = - Compiler.AssertSingleErrorTypeCheck + CompilerAssert.TypeCheckSingleError """ type StructClass<'a when 'a : struct>() = class end let sAnon = StructClass<{| S: int |}>() """ 1 (3, 12, 3, 37) - "A generic construct requires that the type '{|S : int|}' is a CLI or F# struct type" - + "A generic construct requires that the type '{|S : int|}' is a CLI or F# struct type" \ No newline at end of file diff --git a/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs b/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs new file mode 100644 index 00000000000..b6f5ce9d952 --- /dev/null +++ b/tests/fsharp/Compiler/Language/SpanOptimizationTests.fs @@ -0,0 +1,232 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework + +#if !NETCOREAPP +[] +module SpanOptimizationTests = + + [] + let SpanForInDo() = + let source = + """ +module Test + +open System + +let test () = + let span = Span.Empty + for item in span do + 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 +{ + + .maxstack 5 + .locals init (valuetype [System.Memory]System.Span`1 V_0, + int32 V_1, + int32 V_2, + object& V_3) + IL_0000: call valuetype [System.Memory]System.Span`1 valuetype [System.Memory]System.Span`1::get_Empty() + IL_0005: stloc.0 + IL_0006: ldc.i4.0 + IL_0007: stloc.2 + IL_0008: ldloca.s V_0 + IL_000a: call instance int32 valuetype [System.Memory]System.Span`1::get_Length() + IL_000f: ldc.i4.1 + IL_0010: sub + IL_0011: stloc.1 + IL_0012: ldloc.1 + IL_0013: ldloc.2 + IL_0014: blt.s IL_0034 + + IL_0016: ldloca.s V_0 + IL_0018: ldloc.2 + IL_0019: call instance !0& valuetype [System.Memory]System.Span`1::get_Item(int32) + IL_001e: stloc.3 + IL_001f: ldloc.3 + IL_0020: ldobj [mscorlib]System.Object + IL_0025: call void [mscorlib]System.Console::WriteLine(object) + IL_002a: ldloc.2 + IL_002b: ldc.i4.1 + IL_002c: add + IL_002d: stloc.2 + IL_002e: ldloc.2 + IL_002f: ldloc.1 + IL_0030: ldc.i4.1 + IL_0031: add + IL_0032: bne.un.s IL_0016 + + IL_0034: ret +} """ + ] + + [] + let ReadOnlySpanForInDo() = + let source = + """ +module Test + +open System + +let test () = + let span = ReadOnlySpan.Empty + for item in span do + 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 + { + + .maxstack 5 + .locals init (valuetype [System.Memory]System.ReadOnlySpan`1 V_0, + int32 V_1, + int32 V_2, + object& V_3) + IL_0000: call valuetype [System.Memory]System.ReadOnlySpan`1 valuetype [System.Memory]System.ReadOnlySpan`1::get_Empty() + IL_0005: stloc.0 + IL_0006: ldc.i4.0 + IL_0007: stloc.2 + IL_0008: ldloca.s V_0 + IL_000a: call instance int32 valuetype [System.Memory]System.ReadOnlySpan`1::get_Length() + IL_000f: ldc.i4.1 + IL_0010: sub + IL_0011: stloc.1 + IL_0012: ldloc.1 + IL_0013: ldloc.2 + IL_0014: blt.s IL_0034 + + IL_0016: ldloca.s V_0 + IL_0018: ldloc.2 + IL_0019: call instance !0& modreq([netstandard]System.Runtime.InteropServices.InAttribute) valuetype [System.Memory]System.ReadOnlySpan`1::get_Item(int32) + IL_001e: stloc.3 + IL_001f: ldloc.3 + IL_0020: ldobj [mscorlib]System.Object + IL_0025: call void [mscorlib]System.Console::WriteLine(object) + IL_002a: ldloc.2 + IL_002b: ldc.i4.1 + IL_002c: add + IL_002d: stloc.2 + IL_002e: ldloc.2 + IL_002f: ldloc.1 + IL_0030: ldc.i4.1 + IL_0031: add + IL_0032: bne.un.s IL_0016 + + IL_0034: ret + }""" + ] + + [] + let ExplicitSpanTypeForInDo() = + + let source = + """ +namespace System.Runtime.CompilerServices + +open System + +[] +type IsByRefLikeAttribute() = + inherit Attribute() + +namespace System + +open System.Collections +open System.Runtime.CompilerServices + +[] +type Span<'T>(arr: 'T []) = + + member __.Item + with get (i: int) = &arr.[0] + + member __.Length + with get () = 0 + + static member Empty = Span<'T>([||]) + + interface IEnumerable with + + member __.GetEnumerator() = null + +module Test = + + let test () = + let span = Span.Empty + for item in span do + Console.WriteLine(item) + """ + + // The current behavior doesn't optimize, but it could in the future. Making a test to catch if it ever does. + ILChecker.checkWithDlls + (ILChecker.getPackageDlls "System.Memory" "4.5.2" "netstandard2.0" [ "System.Memory.dll" ]) + source + [ + """.method public static void test() cil managed + { + + .maxstack 3 + .locals init (valuetype System.Span`1 V_0, + class [mscorlib]System.Collections.IEnumerator V_1, + class [FSharp.Core]Microsoft.FSharp.Core.Unit V_2, + class [mscorlib]System.IDisposable V_3) + IL_0000: ldc.i4.0 + IL_0001: newarr [mscorlib]System.Object + IL_0006: newobj instance void valuetype System.Span`1::.ctor(!0[]) + IL_000b: stloc.0 + IL_000c: ldloc.0 + IL_000d: box valuetype System.Span`1 + IL_0012: unbox.any [mscorlib]System.Collections.IEnumerable + IL_0017: callvirt instance class [mscorlib]System.Collections.IEnumerator [mscorlib]System.Collections.IEnumerable::GetEnumerator() + IL_001c: stloc.1 + .try + { + IL_001d: ldloc.1 + IL_001e: callvirt instance bool [mscorlib]System.Collections.IEnumerator::MoveNext() + IL_0023: brfalse.s IL_0032 + + IL_0025: ldloc.1 + IL_0026: callvirt instance object [mscorlib]System.Collections.IEnumerator::get_Current() + IL_002b: call void [mscorlib]System.Console::WriteLine(object) + IL_0030: br.s IL_001d + + IL_0032: ldnull + IL_0033: stloc.2 + IL_0034: leave.s IL_004c + + } + finally + { + IL_0036: ldloc.1 + IL_0037: isinst [mscorlib]System.IDisposable + IL_003c: stloc.3 + IL_003d: ldloc.3 + IL_003e: brfalse.s IL_0049 + + IL_0040: ldloc.3 + IL_0041: callvirt instance void [mscorlib]System.IDisposable::Dispose() + IL_0046: ldnull + IL_0047: pop + IL_0048: endfinally + IL_0049: ldnull + IL_004a: pop + IL_004b: endfinally + } + IL_004c: ldloc.2 + IL_004d: pop + IL_004e: ret + }""" + ] +#endif diff --git a/tests/fsharp/Compiler/Language/SpanTests.fs b/tests/fsharp/Compiler/Language/SpanTests.fs new file mode 100644 index 00000000000..cbac744a719 --- /dev/null +++ b/tests/fsharp/Compiler/Language/SpanTests.fs @@ -0,0 +1,53 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open System +open NUnit.Framework + +#if NETCOREAPP +[] +module SpanTests = + + [] + let Script_SpanForInDo() = + let script = + """ +open System + +let test () : unit = + let span = Span([|1;2;3;4|]) + let result = ResizeArray() + for item in span do + result.Add(item) + + if result.[0] <> 1 || result.[1] <> 2 || result.[2] <> 3 || result.[3] <> 4 then + failwith "SpanForInDo didn't work properly" + +test () + """ + + CompilerAssert.RunScript script [] + + [] + let Script_ReadOnlySpanForInDo() = + let script = + """ +open System + +let test () : unit = + let span = ReadOnlySpan([|1;2;3;4|]) + let result = ResizeArray() + for item in span do + result.Add(item) + + if result.[0] <> 1 || result.[1] <> 2 || result.[2] <> 3 || result.[3] <> 4 then + failwith "ReadOnlySpanForInDo didn't work properly" + +test () + """ + + // We expect this error until System.Reflection.Emit gets fixed for emitting `modreq` on method calls. + // See: https://github.com/dotnet/corefx/issues/29254 + CompilerAssert.RunScript script [ "Method not found: '!0 ByRef System.ReadOnlySpan`1.get_Item(Int32)'." ] +#endif \ No newline at end of file diff --git a/tests/FSharp.Compiler.UnitTests/Language/StringConcat.fs b/tests/fsharp/Compiler/Language/StringConcatOptimizationTests.fs similarity index 99% rename from tests/FSharp.Compiler.UnitTests/Language/StringConcat.fs rename to tests/fsharp/Compiler/Language/StringConcatOptimizationTests.fs index 4069052a033..494b4f1fe69 100644 --- a/tests/FSharp.Compiler.UnitTests/Language/StringConcat.fs +++ b/tests/fsharp/Compiler/Language/StringConcatOptimizationTests.fs @@ -5,13 +5,12 @@ namespace FSharp.Compiler.UnitTests open System open NUnit.Framework +#if !NETCOREAPP [] -module StringConcat = +module StringConcatOptimizationTests = -// helper methods in this test only run on the full framework -#if !NETCOREAPP + // helper methods in this test only run on the full framework [] -#endif let Optimizations () = let baseSource = """ module Test @@ -846,3 +845,4 @@ let test9 () = test8IL test9IL ] +#endif \ No newline at end of file diff --git a/tests/FSharp.Compiler.UnitTests/SourceTextTests.fs b/tests/fsharp/Compiler/SourceTextTests.fs similarity index 100% rename from tests/FSharp.Compiler.UnitTests/SourceTextTests.fs rename to tests/fsharp/Compiler/SourceTextTests.fs diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 9d505e91cf6..44645a569b1 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -30,6 +30,13 @@ + + + + + + + diff --git a/tests/fsharp/test-framework.fs b/tests/fsharp/test-framework.fs index b7a18df6f20..06cb0b278e4 100644 --- a/tests/fsharp/test-framework.fs +++ b/tests/fsharp/test-framework.fs @@ -152,10 +152,11 @@ type FSLibPaths = let requireFile nm = if Commands.fileExists __SOURCE_DIRECTORY__ nm |> Option.isSome then nm else failwith (sprintf "couldn't find %s. Running 'build test' once might solve this issue" nm) +let packagesDir = Environment.GetEnvironmentVariable("USERPROFILE") ++ ".nuget" ++ "packages" + let config configurationName envVars = let SCRIPT_ROOT = __SOURCE_DIRECTORY__ - let packagesDir = Environment.GetEnvironmentVariable("USERPROFILE") ++ ".nuget" ++ "packages" #if NET472 let fscArchitecture = "net472" let fsiArchitecture = "net472" diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index 426236543f7..da7ae84baf2 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -73,6 +73,33 @@ type internal FSharpCheckerWorkspaceServiceFactory member this.Checker = checkerProvider.Checker member this.FSharpProjectOptionsManager = projectInfoManager } +[] +type private FSharpSolutionEvents(projectManager: FSharpProjectOptionsManager) = + + interface IVsSolutionEvents with + + member __.OnAfterCloseSolution(_) = + projectManager.Checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() + VSConstants.S_OK + + member __.OnAfterLoadProject(_, _) = VSConstants.E_NOTIMPL + + member __.OnAfterOpenProject(_, _) = VSConstants.E_NOTIMPL + + member __.OnAfterOpenSolution(_, _) = VSConstants.E_NOTIMPL + + member __.OnBeforeCloseProject(_, _) = VSConstants.E_NOTIMPL + + member __.OnBeforeCloseSolution(_) = VSConstants.E_NOTIMPL + + member __.OnBeforeUnloadProject(_, _) = VSConstants.E_NOTIMPL + + member __.OnQueryCloseProject(_, _, _) = VSConstants.E_NOTIMPL + + member __.OnQueryCloseSolution(_, _) = VSConstants.E_NOTIMPL + + member __.OnQueryUnloadProject(_, _) = VSConstants.E_NOTIMPL + [, Microsoft.CodeAnalysis.Host.Mef.ServiceLayer.Default)>] type internal FSharpSettingsFactory [] (settings: EditorOptions) = @@ -143,6 +170,8 @@ type internal FSharpPackage() as this = vfsiToolWindow <- this.FindToolWindow(typeof, 0, true) :?> Microsoft.VisualStudio.FSharp.Interactive.FsiToolWindow vfsiToolWindow :> Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI + let mutable solutionEventsOpt = None + // FSI-LINKAGE-POINT: unsited init do Microsoft.VisualStudio.FSharp.Interactive.Hooks.fsiConsoleWindowPackageCtorUnsited (this :> Package) @@ -165,9 +194,13 @@ type internal FSharpPackage() as this = let projectInfoManager = this.ComponentModel.DefaultExportProvider.GetExport().Value let solution = this.GetServiceAsync(typeof).Result let solution = solution :?> IVsSolution + let solutionEvents = FSharpSolutionEvents(projectInfoManager) let rdt = this.GetServiceAsync(typeof).Result let rdt = rdt :?> IVsRunningDocumentTable + solutionEventsOpt <- Some(solutionEvents) + solution.AdviseSolutionEvents(solutionEvents) |> ignore + let projectContextFactory = this.ComponentModel.GetService() let workspace = this.ComponentModel.GetService() let miscFilesWorkspace = this.ComponentModel.GetService()