diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index a91660a6bf4..4422b93e9d7 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -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 \ No newline at end of file diff --git a/src/fsharp/NicePrint.fsi b/src/fsharp/NicePrint.fsi index 59e436b5312..9792aafda48 100644 --- a/src/fsharp/NicePrint.fsi +++ b/src/fsharp/NicePrint.fsi @@ -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 diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 3690154175d..7d4a97adc31 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -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 + 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" diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 93ab0cfcf05..36353a69a63 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -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 diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index a577dacb842..9e4f2c129f1 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -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]) @@ -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) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 70a0b001238..76b2b3e3539 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -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)) diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index e41689f3bba..ad96fb7e93d 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -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 = diff --git a/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs b/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs new file mode 100644 index 00000000000..174493fe065 --- /dev/null +++ b/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs @@ -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 + +[] +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 + + [] + let ``Generate signature with correct namespace``() = + """ +namespace ANamespaceForSignature + """ + |> sigShouldBe """namespace rec ANamespaceForSignature""" + + [] + let ``Generate signature with correct namespace 2``() = + """ +namespace Test.ANamespaceForSignature + """ + |> sigShouldBe """namespace rec Test.ANamespaceForSignature""" + + [] + let ``Generate signature with correct namespace 3``() = + """ +namespace Test.ANamespaceForSignature + +namespace Test2.ANamespaceForSignature2 + """ + |> sigShouldBe """namespace rec Test.ANamespaceForSignature + +namespace rec Test2.ANamespaceForSignature2""" + + + [] + let ``Generate signature with correct namespace and type``() = + """ +namespace Test.ANamespaceForSignature + +type TestType = class end + """ + |> sigShouldBe """namespace rec Test.ANamespaceForSignature + +type TestType""" + + [] + 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 }""" + + [] + 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 }""" + + [] + let ``Generate signature with correct module``() = + """ +module AModuleForSignature + """ + |> sigShouldBe """module rec AModuleForSignature""" + + [] + let ``Generate signature with correct module 2``() = + """ +module Test.AModuleForSignature + """ + |> sigShouldBe """namespace rec Test + +module rec AModuleForSignature = begin end""" + + [] + let ``Generate signature with correct module includes attributes``() = + // TODO: This should trim the "Attribute ()". + """ +[] +module AModuleForSignature + """ + |> sigShouldBe """[] +module rec AModuleForSignature""" diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index a6f0066aca0..952372043cf 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -25,6 +25,7 @@ +