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
96 changes: 96 additions & 0 deletions src/fsharp/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2085,3 +2085,99 @@ let minimalStringOfType denv ty =
let denvMin = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false }
showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 2 ty)

let layoutOfModuleOrNamespaceType (denv: DisplayEnv) (infoReader: InfoReader) (ad: AccessibilityLogic.AccessorDomain) (mty: ModuleOrNamespaceType) =

let sepDoubleLineBreakL = (sepL lineBreak ^^ sepL lineBreak)

let rec fullPath (mspec: ModuleOrNamespace) acc =
if mspec.IsNamespace then
match mspec.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions |> List.tryHead with
| Some next when next.IsNamespace ->
fullPath next (acc @ [next.DemangledModuleOrNamespaceName])
| _ ->
acc, mspec
else
acc, mspec

let rec moduleOrNamespaceL isFirstTopLevel (denv: DisplayEnv) (mspec: ModuleOrNamespace) =
let outerPath = mspec.CompilationPath.AccessPath

let path, mspec = fullPath mspec [mspec.DemangledModuleOrNamespaceName]

let denv = denv.AddOpenPath path
let nextL =
if mspec.IsNamespace then
// This is a container namespace. We print the header when we get to the first concrete module.
wordL (tagKeyword "namespace") ^^ wordL (tagKeyword "rec") ^^ sepListL SepL.dot (List.map (tagNamespace >> wordL) path)
else
// This is a module
let nmL =
match path with
| [nm] -> wordL (tagModule nm)
| _ ->
let nm = path |> List.last
let innerPath = path.[..path.Length - 2]
sepListL SepL.dot (List.map (tagNamespace >> wordL) innerPath) ^^ SepL.dot ^^ wordL (tagModule nm)
// Check if its an outer module or a nested module
if (outerPath |> List.forall (fun (_, istype) -> istype = Namespace)) then
// Check if this is an outer module with no namespace
if isNil outerPath then
// If so print a "module" declaration
(wordL (tagKeyword "module") ^^ wordL (tagKeyword "rec") ^^ nmL)
else
if mspec.ModuleOrNamespaceType.AllEntities |> Seq.isEmpty && mspec.ModuleOrNamespaceType.AllValsAndMembers |> Seq.isEmpty then
(wordL (tagKeyword "module") ^^ wordL (tagKeyword "rec") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword "begin") ^^ wordL (tagKeyword "end"))
else
// Otherwise this is an outer module contained immediately in a namespace
// We already printed the namespace declaration earlier. So just print the
// module now.
(wordL (tagKeyword "module") ^^ wordL (tagKeyword "rec") ^^ nmL ^^ WordL.equals)
else
if mspec.ModuleOrNamespaceType.AllEntities |> Seq.isEmpty && mspec.ModuleOrNamespaceType.AllValsAndMembers |> Seq.isEmpty then
(wordL (tagKeyword "module") ^^ wordL (tagKeyword "rec") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword "begin") ^^ wordL (tagKeyword "end"))
else
// OK, this is a nested module
(wordL (tagKeyword "module") ^^ wordL (tagKeyword "rec") ^^ nmL ^^ WordL.equals)

let nextL =
PrintTypes.layoutAttribs denv false (generalizedTyconRef(mkLocalEntityRef mspec)) mspec.TypeOrMeasureKind mspec.Attribs nextL

let entityLs =
mspec.ModuleOrNamespaceType.AllEntities
|> QueueList.toList
|> List.map (fun entity ->
if entity.IsModuleOrNamespace then
moduleOrNamespaceL false denv entity
else
layoutTycon denv infoReader ad Range.range0 entity
)

if List.isEmpty entityLs then
nextL
else
let entitiesL =
match entityLs with
| [] -> emptyL
| [entityL] -> entityL
| entityL :: entityLs ->
entityL @@
(
entityLs
|> List.map (fun entityL -> sepL lineBreak ^^ entityL)
|> aboveListL
)

if isFirstTopLevel then
aboveL
(nextL ^^ sepL lineBreak)
entitiesL
else
(nextL ^^ sepL lineBreak) @@- entitiesL

let moduleOrNamespaces =
mty.ModuleAndNamespaceDefinitions
|> List.map (fun mspec ->
moduleOrNamespaceL true denv mspec
)

sepListL sepDoubleLineBreakL moduleOrNamespaces
2 changes: 2 additions & 0 deletions src/fsharp/NicePrint.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -113,3 +113,5 @@ val minimalStringsOfTwoTypes: denv:DisplayEnv -> t1:TType -> t2:TType -> string
val minimalStringsOfTwoValues: denv:DisplayEnv -> v1:Val -> v2:Val -> string * string

val minimalStringOfType: denv:DisplayEnv -> ty:TType -> string

val layoutOfModuleOrNamespaceType: denv:DisplayEnv -> infoReader: InfoReader -> ad: AccessibilityLogic.AccessorDomain -> mty:ModuleOrNamespaceType -> Layout
41 changes: 41 additions & 0 deletions src/fsharp/service/FSharpCheckerResults.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1969,6 +1969,47 @@ type FSharpCheckFileResults
threadSafeOp (fun () -> None) (fun scope ->
let (nenv, _), _ = scope.GetBestDisplayEnvForPos cursorPos
Some(FSharpDisplayContext(fun _ -> nenv.DisplayEnv)))

member _.GenerateSignatureText() =
threadSafeOp (fun () -> None) (fun scope ->
let tcGlobals = scope.TcGlobals

let denv = DisplayEnv.Empty tcGlobals
let denv =
{ denv with
showImperativeTyparAnnotations=true
showHiddenMembers=true
showObsoleteMembers=true
showAttributes=true
shrinkOverloads=false
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does this impact tooltips? We shrink overloads for those

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, this is a separate pass to generating text versus tooltips.

printVerboseSignatures=false }

let rec pathForSynTy (_synTy: SynType) =
List.empty

let extraOpenPaths =
scope.OpenDeclarations
|> Seq.map (fun x ->
match x.Target with
| SynOpenDeclTarget.ModuleOrNamespace(lid, _) -> lid |> List.map (fun x -> x.idText)
| SynOpenDeclTarget.Type(synTy, _) -> pathForSynTy synTy
)
|> List.ofSeq

let denv =
denv.SetOpenPaths
([ FSharpLib.RootPath
FSharpLib.CorePath
FSharpLib.CollectionsPath
FSharpLib.ControlPath
(IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName)
] @ extraOpenPaths)

let infoReader = InfoReader(scope.SymbolEnv.g, scope.SymbolEnv.amap)
NicePrint.layoutOfModuleOrNamespaceType denv infoReader scope.AccessRights scope.CcuSigForFile |> LayoutRender.showL
|> SourceText.ofString
|> Some
)

member _.ImplementationFile =
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"
Expand Down
3 changes: 3 additions & 0 deletions src/fsharp/service/FSharpCheckerResults.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -296,6 +296,9 @@ type public FSharpCheckFileResults =
/// Determines if a long ident is resolvable at a specific point.
member IsRelativeNameResolvableFromSymbol: cursorPos : pos * plid : string list * symbol: FSharpSymbol -> bool

/// Generates a signature of the file as source text.
member GenerateSignatureText: unit -> ISourceText option

/// Represents complete typechecked implementation file, including its typechecked signatures if any.
member ImplementationFile: FSharpImplementationFileContents option

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1395,6 +1395,7 @@ FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FShar
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpDisplayContext] GetDisplayContextForPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpImplementationFileContents] ImplementationFile
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpImplementationFileContents] get_ImplementationFile()
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.ISourceText] GenerateSignatureText()
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.CodeAnalysis.FSharpSymbolUse]] GetMethodsAsSymbols(Int32, Int32, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String])
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[System.String] GetF1Keyword(Int32, Int32, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String])
FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: System.Collections.Generic.IEnumerable`1[FSharp.Compiler.CodeAnalysis.FSharpSymbolUse] GetAllUsesOfAllSymbolsInFile(Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken])
Expand Down Expand Up @@ -1494,11 +1495,11 @@ FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Syntax.Pars
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Syntax.ParsedInput get_ParseTree()
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.EditorServices.ParameterLocations] FindParameterLocations(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfExprInYieldOrReturn(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfExpressionBeingDereferencedContainingPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfFunctionOrMethodBeingApplied(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfNameOfNearestOuterBindingContainingPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfRecordExpressionContainingPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfRefCellDereferenceContainingPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfExpressionBeingDereferencedContainingPos(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] ValidateBreakpointLocation(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range]] GetAllArgumentsForFunctionApplicationAtPostion(FSharp.Compiler.Text.Position)
FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.Ident,System.Int32]] TryIdentOfPipelineContainingPosAndNumArgsApplied(FSharp.Compiler.Text.Position)
Expand Down
11 changes: 11 additions & 0 deletions tests/FSharp.Test.Utilities/Compiler.fs
Original file line number Diff line number Diff line change
Expand Up @@ -426,6 +426,17 @@ module rec Compiler =
| FS fs -> typecheckFSharp fs
| _ -> failwith "Typecheck only supports F#"

let typecheckResults (cUnit: CompilationUnit) : FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults =
match cUnit with
| FS fsSource ->
let source = getSource fsSource.Source
let options = fsSource.Options |> Array.ofList

let name = match fsSource.Name with | None -> "test.fs" | Some n -> n

CompilerAssert.TypeCheck(options, name, source)
| _ -> failwith "Typecheck only supports F#"

let run (result: TestResult) : TestResult =
match result with
| Failure f -> failwith (sprintf "Compilation should be successfull in order to run.\n Errors: %A" (f.Diagnostics))
Expand Down
23 changes: 23 additions & 0 deletions tests/FSharp.Test.Utilities/CompilerAssert.fs
Original file line number Diff line number Diff line change
Expand Up @@ -649,6 +649,29 @@ let main argv = 0"""

errors

/// Parses and type checks the given source. Fails if type checker is aborted.
static member ParseAndTypeCheck(options, name, source: string) =
lock gate <| fun () ->
let parseResults, fileAnswer =
checker.ParseAndCheckFileInProject(
name,
0,
SourceText.ofString source,
{ defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions})
|> Async.RunSynchronously

match fileAnswer with
| FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); failwith "Type Checker Aborted"
| FSharpCheckFileAnswer.Succeeded(typeCheckResults) -> parseResults, typeCheckResults

/// Parses and type checks the given source. Fails if the type checker is aborted or the parser returns any diagnostics.
static member TypeCheck(options, name, source: string) =
let parseResults, checkResults = CompilerAssert.ParseAndTypeCheck(options, name, source)

Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics)

checkResults

static member TypeCheckWithErrorsAndOptionsAndAdjust options libAdjust (source: string) expectedTypeErrors =
lock gate <| fun () ->
let errors =
Expand Down
125 changes: 125 additions & 0 deletions tests/fsharp/Compiler/Service/SignatureGenerationTests.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,125 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

namespace FSharp.Compiler.UnitTests

open FSharp.Compiler.Diagnostics
open NUnit.Framework
open FSharp.Test.Utilities
open FSharp.Test.Utilities.Utilities
open FSharp.Test.Utilities.Compiler
open FSharp.Tests

[<TestFixture>]
module SignatureGenerationTests =

let sigText (checkResults: FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults) =
match checkResults.GenerateSignatureText() with
| None -> failwith "Unable to generate signature text."
| Some text -> text

let sigShouldBe (expected: string) src =
let text =
FSharp src
|> withLangVersion50
|> typecheckResults
|> sigText

let actual = text.ToString()
let expected2 = expected.Replace("\r\n", "\n")
Assert.shouldBeEquivalentTo expected2 actual

[<Test>]
let ``Generate signature with correct namespace``() =
"""
namespace ANamespaceForSignature
"""
|> sigShouldBe """namespace rec ANamespaceForSignature"""

[<Test>]
let ``Generate signature with correct namespace 2``() =
"""
namespace Test.ANamespaceForSignature
"""
|> sigShouldBe """namespace rec Test.ANamespaceForSignature"""

[<Test>]
let ``Generate signature with correct namespace 3``() =
"""
namespace Test.ANamespaceForSignature

namespace Test2.ANamespaceForSignature2
"""
|> sigShouldBe """namespace rec Test.ANamespaceForSignature

namespace rec Test2.ANamespaceForSignature2"""


[<Test>]
let ``Generate signature with correct namespace and type``() =
"""
namespace Test.ANamespaceForSignature

type TestType = class end
"""
|> sigShouldBe """namespace rec Test.ANamespaceForSignature

type TestType"""

[<Test>]
let ``Generate signature with correct namespace and private inner record type``() =
"""
namespace Test.ANamespaceForSignature

type TestType = private { x: int }
"""
|> sigShouldBe """namespace rec Test.ANamespaceForSignature

type TestType =
private { x: int }"""

[<Test>]
let ``Generate signature with correct namespace and private inner record type and module with private inner record type``() =
"""
namespace Test.ANamespaceForSignature

type TestType = private { x: int }

module ModuleA =

type TestType2 = private { x: float32 }
"""
|> sigShouldBe """namespace rec Test.ANamespaceForSignature

type TestType =
private { x: int }

module rec ModuleA =

type TestType2 =
private { x: float32 }"""

[<Test>]
let ``Generate signature with correct module``() =
"""
module AModuleForSignature
"""
|> sigShouldBe """module rec AModuleForSignature"""

[<Test>]
let ``Generate signature with correct module 2``() =
"""
module Test.AModuleForSignature
"""
|> sigShouldBe """namespace rec Test

module rec AModuleForSignature = begin end"""

[<Test>]
let ``Generate signature with correct module includes attributes``() =
// TODO: This should trim the "Attribute ()".
"""
[<RequireQualifiedAccess>]
module AModuleForSignature
"""
|> sigShouldBe """[<RequireQualifiedAccessAttribute ()>]
module rec AModuleForSignature"""
1 change: 1 addition & 0 deletions tests/fsharp/FSharpSuite.Tests.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@
<Compile Include="single-test.fs" />
<Compile Include="TypeProviderTests.fs" />
<Compile Include="tests.fs" />
<Compile Include="Compiler\Service\SignatureGenerationTests.fs" />
<Compile Include="Compiler\CodeGen\EmittedIL\StaticMember.fs" />
<Compile Include="Compiler\CodeGen\EmittedIL\StaticLinkTests.fs" />
<Compile Include="Compiler\CodeGen\EmittedIL\Mutation.fs" />
Expand Down