From a318125f1a1f27a7ae73671552b27e647a1cadd5 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 27 Sep 2017 22:47:31 +0300 Subject: [PATCH 1/6] add LanguageServiceProfiling project to internals visible to list of FSharp.Compiler.Private project --- src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs b/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs index b658d62627a..c74e002c1b9 100644 --- a/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs +++ b/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs @@ -46,6 +46,7 @@ open System.Runtime.InteropServices [] [] [] +[] #endif #if STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY [] From 57b00d1606ff24e06e519ba5d1cb3c1a767e5f8c Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 28 Sep 2017 20:47:47 +0300 Subject: [PATCH 2/6] add ImplementationFiles to FSharpCheckFileResults --- src/fsharp/symbols/Exprs.fsi | 1 + src/fsharp/vs/IncrementalBuild.fs | 6 ++++-- src/fsharp/vs/IncrementalBuild.fsi | 4 +++- src/fsharp/vs/service.fs | 18 ++++++++++++++---- src/fsharp/vs/service.fsi | 2 ++ 5 files changed, 24 insertions(+), 7 deletions(-) diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 291f380e297..c65cb62a4c4 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -28,6 +28,7 @@ and [] FSharpImplementationFileContents = #else and [] internal FSharpImplementationFileContents = #endif + new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations member QualifiedName: string diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index f940a554be1..9a12986a827 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1095,7 +1095,8 @@ type PartialCheckResults = TcSymbolUses: TcSymbolUses list TcDependencyFiles: string list TopAttribs: TopAttribs option - TimeStamp: System.DateTime } + TimeStamp: System.DateTime + ImplementationFiles: TypedImplFile list } static member Create (tcAcc: TypeCheckAccumulator, timestamp) = { TcState = tcAcc.tcState @@ -1108,7 +1109,8 @@ type PartialCheckResults = TcSymbolUses = tcAcc.tcSymbolUses TcDependencyFiles = tcAcc.tcDependencyFiles TopAttribs = tcAcc.topAttribs - TimeStamp = timestamp } + TimeStamp = timestamp + ImplementationFiles = tcAcc.typedImplFiles } [] diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index 3364cf212c4..2586f2145a6 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -59,7 +59,9 @@ type internal PartialCheckResults = /// Represents the collected attributes to apply to the module of assuembly generates TopAttribs: TypeChecker.TopAttribs option - TimeStamp: DateTime } + TimeStamp: DateTime + + ImplementationFiles: TypedImplFile list } /// Manages an incremental build graph for the build of an F# project [] diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index f8e1dac2df8..5b39e74a916 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -163,7 +163,8 @@ type TypeCheckInfo loadClosure : LoadClosure option, reactorOps : IReactorOperations, checkAlive : (unit -> bool), - textSnapshotInfo:obj option) = + textSnapshotInfo:obj option, + implementationFiles: TypedImplFile list) = let textSnapshotInfo = defaultArg textSnapshotInfo null let (|CNR|) (cnr:CapturedNameResolution) = @@ -1356,6 +1357,8 @@ type TypeCheckInfo /// The assembly being analyzed member __.ThisCcu = thisCcu + member __.ImplementationFiles = implementationFiles + override __.ToString() = "TypeCheckInfo(" + mainInputFileName + ")" @@ -1662,7 +1665,7 @@ module internal Parser = let errors = errHandler.CollectedDiagnostics match tcEnvAtEndOpt with - | Some (tcEnvAtEnd, _typedImplFiles, tcState) -> + | Some (tcEnvAtEnd, typedImplFiles, tcState) -> let scope = TypeCheckInfo(tcConfig, tcGlobals, tcState.PartialAssemblySignature, @@ -1678,7 +1681,8 @@ module internal Parser = loadClosure, reactorOps, checkAlive, - textSnapshotInfo) + textSnapshotInfo, + typedImplFiles) return errors, TypeCheckAborted.No scope | None -> return errors, TypeCheckAborted.Yes @@ -2002,6 +2006,11 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp RequireCompilationThread ctok scope.IsRelativeNameResolvable(pos, plid, item)) + member info.ImplementationFiles = + scopeOptX + |> Option.map (fun scope -> + let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) + [ for mimpl in scope.ImplementationFiles -> FSharpImplementationFileContents(cenv, mimpl)]) override info.ToString() = "FSharpCheckFileResults(" + filename + ")" @@ -2624,7 +2633,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC List.last tcProj.TcResolutions, List.last tcProj.TcSymbolUses, tcProj.TcEnvAtEnd.NameEnv, - loadClosure, reactorOps, (fun () -> builder.IsAlive), None) + loadClosure, reactorOps, (fun () -> builder.IsAlive), None, + tcProj.ImplementationFiles) let typedResults = MakeCheckFileResults(filename, options, builder, scope, tcProj.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) return (parseResults, typedResults) }) diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 2d55ebd91f7..8041006788d 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -262,6 +262,8 @@ type internal FSharpCheckFileResults = /// An optional string used for tracing compiler operations associated with this request. member internal IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ?userOpName: string -> Async + member ImplementationFiles: FSharpImplementationFileContents list option + /// A handle to the results of CheckFileInProject. [] #if COMPILER_PUBLIC_API From 7a765b709cec6d1c7ec4421a47e6b280cd916b76 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 28 Sep 2017 21:41:20 +0300 Subject: [PATCH 3/6] make FSharpImplementationFileContents ctor internal --- src/fsharp/symbols/Exprs.fsi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index c65cb62a4c4..7aa34ed00d5 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -28,7 +28,7 @@ and [] FSharpImplementationFileContents = #else and [] internal FSharpImplementationFileContents = #endif - new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents + internal new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations member QualifiedName: string From 89574185ff9ddc36d06a43a716b22d6a6e7df658 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 29 Sep 2017 15:39:08 +0300 Subject: [PATCH 4/6] throw if ImplementationFiles is called having keepAssemblyContents flag set to false --- src/fsharp/vs/service.fs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 5b39e74a916..0a744ddaa3e 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1821,7 +1821,7 @@ type FSharpCheckProjectResults(projectFileName:string, keepAssemblyContents, err // // There is an important property of all the objects returned by the methods of this type: they do not require // the corresponding background builder to be alive. That is, they are simply plain-old-data through pre-formatting of all result text. -type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo option, dependencyFiles: string list, builderX: IncrementalBuilder option, reactorOpsX:IReactorOperations) = +type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo option, dependencyFiles: string list, builderX: IncrementalBuilder option, reactorOpsX:IReactorOperations, keepAssemblyContents: bool) = // This may be None initially, or may be set to None when the object is disposed or finalized let mutable details = match scopeOptX with None -> None | Some scopeX -> Some (scopeX, builderX, reactorOpsX) @@ -2007,6 +2007,7 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp scope.IsRelativeNameResolvable(pos, plid, item)) member info.ImplementationFiles = + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX |> Option.map (fun scope -> let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) @@ -2335,7 +2336,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC static let mutable foregroundTypeCheckCount = 0 let MakeCheckFileResultsEmpty(filename, creationErrors) = - FSharpCheckFileResults (filename, Array.ofList creationErrors, None, [], None, reactorOps) + FSharpCheckFileResults (filename, Array.ofList creationErrors, None, [], None, reactorOps, keepAssemblyContents) let MakeCheckFileResults(filename, options:FSharpProjectOptions, builder, scope, dependencyFiles, creationErrors, parseErrors, tcErrors) = let errors = @@ -2346,7 +2347,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC else yield! tcErrors |] - FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, Some builder, reactorOps) + FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, Some builder, reactorOps, keepAssemblyContents) let MakeCheckFileAnswer(filename, tcFileResult, options:FSharpProjectOptions, builder, dependencyFiles, creationErrors, parseErrors, tcErrors) = match tcFileResult with @@ -3154,7 +3155,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio match tcFileResult with | Parser.TypeCheckAborted.No scope -> let errors = [| yield! parseErrors; yield! tcErrors |] - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps) + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps, false) let projectResults = FSharpCheckProjectResults (filename, keepAssemblyContents, errors, Some(tcGlobals, tcImports, scope.ThisCcu, scope.CcuSig, [scope.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles), reactorOps) parseResults, typeCheckResults, projectResults | _ -> From bec6fa84b3f168ee70ba9e1482269062bdfb3633 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 30 Sep 2017 11:15:39 +0300 Subject: [PATCH 5/6] add a test --- src/fsharp/vs/IncrementalBuild.fsi | 1 + src/fsharp/vs/service.fsi | 1 + tests/service/ProjectAnalysisTests.fs | 42 +++++++++++++++++++++++++++ 3 files changed, 44 insertions(+) diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index 2586f2145a6..eb7e0953436 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -61,6 +61,7 @@ type internal PartialCheckResults = TimeStamp: DateTime + /// Represents complete typechecked implementation files, including thier typechecked signatures if any. ImplementationFiles: TypedImplFile list } /// Manages an incremental build graph for the build of an F# project diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 8041006788d..d90bdaa616e 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -262,6 +262,7 @@ type internal FSharpCheckFileResults = /// An optional string used for tracing compiler operations associated with this request. member internal IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ?userOpName: string -> Async + /// Represents complete typechecked implementation files, including thier typechecked signatures if any. member ImplementationFiles: FSharpImplementationFileContents list option /// A handle to the results of CheckFileInProject. diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 18da534ddeb..ec74669ac26 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5174,3 +5174,45 @@ let ``Test line directives in foreground analysis`` () = // see https://github.c [ for e in checkResults1.Errors -> e.StartLineAlternate, e.EndLineAlternate, e.FileName ] |> shouldEqual [(4, 4, ProjectLineDirectives.fileName1)] +//------------------------------------------------------ + +[] +let ``ParseAndCheckFileResults contains ImplFile list if FSharpChecker is created with keepAssemblyContent flag set to true``() = + + let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs") + let base2 = Path.GetTempFileName() + let dllName = Path.ChangeExtension(base2, ".dll") + let projFileName = Path.ChangeExtension(base2, ".fsproj") + let fileSource1 = """ +type A(i:int) = + member x.Value = i +""" + File.WriteAllText(fileName1, fileSource1) + + let fileNames = [fileName1] + let args = mkProjectCommandLineArgs (dllName, fileNames) + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + + let fileCheckResults = + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + |> function + | _, FSharpCheckFileAnswer.Succeeded(res) -> res + | _ -> failwithf "Parsing aborted unexpectedly..." + + let declarations = + match fileCheckResults.ImplementationFiles with + | Some (implFile :: _) -> + match implFile.Declarations |> List.tryHead with + | Some (FSharpImplementationFileDeclaration.Entity (_, subDecls)) -> subDecls + | _ -> failwith "unexpected declaration" + | Some [] | None -> failwith "File check results does not contain any `ImplementationFile`s" + + match declarations |> List.tryHead with + | Some (FSharpImplementationFileDeclaration.Entity(entity, [])) -> + entity.DisplayName |> shouldEqual "A" + let memberNames = entity.MembersFunctionsAndValues |> Seq.map (fun x -> x.DisplayName) |> Set.ofSeq + Assert.That(memberNames, Contains.Item "Value") + + | Some decl -> failwithf "unexpected declaration %A" decl + | None -> failwith "declaration list is empty" From 187227b0533a0ee40aff9589918a49e791fd5066 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 1 Oct 2017 14:36:29 +0300 Subject: [PATCH 6/6] spelling and cosmetics --- src/fsharp/CompileOps.fs | 4 ++-- src/fsharp/CompileOptions.fs | 4 +--- src/fsharp/vs/service.fs | 4 ++-- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 293ae17cbf4..f315999caff 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2835,8 +2835,8 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = member x.embedResources = data.embedResources member x.globalWarnAsError = data.globalWarnAsError member x.globalWarnLevel = data.globalWarnLevel - member x.specificWarnOff = data. specificWarnOff - member x.specificWarnOn = data. specificWarnOn + member x.specificWarnOff = data.specificWarnOff + member x.specificWarnOn = data.specificWarnOn member x.specificWarnAsError = data.specificWarnAsError member x.specificWarnAsWarn = data.specificWarnAsWarn member x.mlCompatibility = data.mlCompatibility diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 40928c1cb03..9e2137ac576 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -380,9 +380,7 @@ let ParseCompilerOptions (collectOtherArgument : string -> unit, blocks: Compile let rest = attempt specs processArg rest - let result = processArg args - result - + processArg args //---------------------------------------------------------------------------- // Compiler options diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 0a744ddaa3e..1035aea4f1b 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1765,7 +1765,7 @@ type FSharpCheckProjectResults(projectFileName:string, keepAssemblyContents, err FSharpAssemblySignature(tcGlobals, thisCcu, tcImports, topAttribs, ccuSig) member info.AssemblyContents = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() let mimpls = match tcAssemblyExpr with @@ -2007,7 +2007,7 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp scope.IsRelativeNameResolvable(pos, plid, item)) member info.ImplementationFiles = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX |> Option.map (fun scope -> let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports)