Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/fsharp/symbols/Exprs.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ and [<Class>] FSharpImplementationFileContents =
#else
and [<Class>] 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
Expand Down
6 changes: 4 additions & 2 deletions src/fsharp/vs/IncrementalBuild.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -1108,7 +1109,8 @@ type PartialCheckResults =
TcSymbolUses = tcAcc.tcSymbolUses
TcDependencyFiles = tcAcc.tcDependencyFiles
TopAttribs = tcAcc.topAttribs
TimeStamp = timestamp }
TimeStamp = timestamp
ImplementationFiles = tcAcc.typedImplFiles }


[<AutoOpen>]
Expand Down
4 changes: 3 additions & 1 deletion src/fsharp/vs/IncrementalBuild.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
[<Class>]
Expand Down
27 changes: 19 additions & 8 deletions src/fsharp/vs/service.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down Expand Up @@ -1356,6 +1357,8 @@ type TypeCheckInfo
/// The assembly being analyzed
member __.ThisCcu = thisCcu

member __.ImplementationFiles = implementationFiles

override __.ToString() = "TypeCheckInfo(" + mainInputFileName + ")"


Expand Down Expand Up @@ -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,
Expand All @@ -1678,7 +1681,8 @@ module internal Parser =
loadClosure,
reactorOps,
checkAlive,
textSnapshotInfo)
textSnapshotInfo,
typedImplFiles)
return errors, TypeCheckAborted.No scope
| None ->
return errors, TypeCheckAborted.Yes
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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 + ")"

Expand Down Expand Up @@ -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 =
Expand All @@ -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
Expand Down Expand Up @@ -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)
})
Expand Down Expand Up @@ -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
| _ ->
Expand Down
2 changes: 2 additions & 0 deletions src/fsharp/vs/service.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -262,6 +262,8 @@ type internal FSharpCheckFileResults =
/// <param name="userOpName">An optional string used for tracing compiler operations associated with this request.</param>
member internal IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ?userOpName: string -> Async<bool>

member ImplementationFiles: FSharpImplementationFileContents list option

/// A handle to the results of CheckFileInProject.
[<Sealed>]
#if COMPILER_PUBLIC_API
Expand Down
42 changes: 42 additions & 0 deletions tests/service/ProjectAnalysisTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)]

//------------------------------------------------------

[<Test>]
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"