diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 70e1550816..1688944f33 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -28,6 +28,7 @@ and [] FSharpImplementationFileContents = #else and [] internal FSharpImplementationFileContents = #endif + internal 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 aacd2e17b6..31771f7b04 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 2af0354aeb..9e3c1579ba 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 da4b9292b3..a142d1d8e2 100755 --- 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 @@ -1817,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) @@ -2002,6 +2006,12 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp RequireCompilationThread ctok 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) + [ for mimpl in scope.ImplementationFiles -> FSharpImplementationFileContents(cenv, mimpl)]) override info.ToString() = "FSharpCheckFileResults(" + filename + ")" @@ -2326,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 = @@ -2337,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 @@ -2624,7 +2634,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) }) @@ -3144,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 | _ -> diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 98df8e598d..72a8f42ca5 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 diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 18da534dde..ec74669ac2 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"