From 51478b6277b9f91107b2de510a0093c207d60ae1 Mon Sep 17 00:00:00 2001 From: nojaf Date: Tue, 23 Aug 2022 16:58:05 +0200 Subject: [PATCH 1/2] Only add open path when module exposes types or bindings. --- src/Compiler/Checking/NicePrint.fs | 20 ++- .../FSharp.Compiler.ComponentTests.fsproj | 4 + .../Signatures/ModuleOrNamespaceTests.fs | 154 ++++++++++++++++++ tests/FSharp.Test.Utilities/Compiler.fs | 13 +- 4 files changed, 184 insertions(+), 7 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index ed7e92bf0ef..f53b6a8a57c 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2326,12 +2326,20 @@ module InferredSigPrinting = let outerPath = mspec.CompilationPath.AccessPath let denv = - innerPath - |> List.choose (fun (path, kind) -> - match kind with - | ModuleOrNamespaceKind.Namespace false -> None - | _ -> Some path) - |> denv.AddOpenPath + match def with + | ModuleOrNamespaceContents.TMDefRec (tycons = []; bindings = bindings) -> + let inline isModule b = + match b with + | ModuleOrNamespaceBinding.Module _ -> true + | ModuleOrNamespaceBinding.Binding _ -> false + + // Don't add the path if it the current ModuleOrNamespace doesn't expose any types or bindings + if List.forall isModule bindings then + denv + else + denv.AddOpenPath (List.map fst innerPath) + | _ -> + denv.AddOpenPath (List.map fst innerPath) if mspec.IsImplicitNamespace then // The current mspec is a namespace that belongs to the `def` child (nested) module(s). diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 4a9e7f7c650..950923f23d7 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -24,6 +24,9 @@ + + FsUnit.fs + @@ -193,6 +196,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs new file mode 100644 index 00000000000..62ee01c07d5 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs @@ -0,0 +1,154 @@ +module FSharp.Compiler.ComponentTests.Signatures.ModuleOrNamespaceTests + +open System +open Xunit +open FsUnit +open FSharp.Test.Compiler + +let inline private prependNewline v = String.Concat("\n", v) + +let equal x = + let x = + match box x with + | :? String as s -> s.Replace("\r\n", "\n") |> box + | x -> x + + equal x + +[] +let ``Type from shared namespace`` () = + FSharp + """ +namespace Foo.Types + +type Area = | Area of string * int + +namespace Foo.Other + +type Map<'t,'v> = + member this.Calculate : Foo.Types.Area = failwith "todo" +""" + |> printSignatures + |> prependNewline + |> should + equal + """ +namespace Foo.Types + + type Area = | Area of string * int +namespace Foo.Other + + type Map<'t,'v> = + + member Calculate: Foo.Types.Area""" + +[] +let ``Return type used in own type definition`` () = + FSharp + """ +namespace Hey.There + +type Foo = + static member Zero : Foo = failwith "todo" +""" + |> printSignatures + |> prependNewline + |> should + equal + """ +namespace Hey.There + + type Foo = + + static member Zero: Foo""" + +[] +let ``Function types`` () = + FSharp + """ +namespace Fantomas.Core + +module Context = + type Context = { SourceCode: string } + +namespace FSharp.Compiler + +module Syntax = + + type SynExpr = + | IfThenElse + | While + +module Text = + type Range = + struct + val startLine: int + val startColumn: int + val endLine: int + val endColumn: int + end + +namespace Fantomas.Core + +module internal CodePrinter = + + open FSharp.Compiler + open FSharp.Compiler.Syntax + open FSharp.Compiler.Text + open Fantomas.Core.Context + + type ASTContext = + { Meh: bool } + static member Default = { Meh = false } + + let rec genExpr (e: SynExpr) (ctx: Context) = ctx + + and genLambdaArrowWithTrivia + (bodyExpr: SynExpr -> Context -> Context) + (body: SynExpr) + (arrowRange: Range option) + : Context -> Context = + id""" + |> printSignatures + |> prependNewline + |> should + equal + """ +namespace Fantomas.Core + + module Context = + + type Context = + { SourceCode: string } +namespace FSharp.Compiler + + module Syntax = + + type SynExpr = + | IfThenElse + | While + + module Text = + + [] + type Range = + + val startLine: int + + val startColumn: int + + val endLine: int + + val endColumn: int +namespace Fantomas.Core + + module internal CodePrinter = + + type ASTContext = + { Meh: bool } + + static member Default: ASTContext + + val genExpr: e: FSharp.Compiler.Syntax.SynExpr -> ctx: Context.Context -> Context.Context + + val genLambdaArrowWithTrivia: bodyExpr: (FSharp.Compiler.Syntax.SynExpr -> Context.Context -> Context.Context) -> body: FSharp.Compiler.Syntax.SynExpr -> arrowRange: FSharp.Compiler.Text.Range option -> (Context.Context -> Context.Context)""" diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index d70cffdafd4..f997930bac1 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1325,8 +1325,19 @@ module rec Compiler = let actual = text.ToString().Split('\n') - |> Array.map (fun s -> s.TrimEnd(' ')) + |> Array.map (fun s -> s.TrimEnd(' ', '\r')) |> Array.filter (fun s -> s.Length > 0) if not (actual |> Array.contains expected) then failwith ($"The following signature:\n%s{expected}\n\nwas not found in:\n" + (actual |> String.concat "\n")) + + let printSignatures cUnit = + cUnit + |> typecheckResults + |> signatureText + |> string + |> fun s -> + s.Replace("\r", "").Split('\n') + |> Array.map (fun line -> line.TrimEnd()) + |> String.concat "\n" + |> fun tap -> tap \ No newline at end of file From 8e7e070816695b11ff19261907b3609d61d94654 Mon Sep 17 00:00:00 2001 From: nojaf Date: Wed, 24 Aug 2022 08:44:16 +0200 Subject: [PATCH 2/2] Re-use isConcreteNamespace helper. --- src/Compiler/Checking/NicePrint.fs | 16 +++------------- .../Signatures/ModuleOrNamespaceTests.fs | 2 +- 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index f53b6a8a57c..9f80ad640a8 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2326,19 +2326,9 @@ module InferredSigPrinting = let outerPath = mspec.CompilationPath.AccessPath let denv = - match def with - | ModuleOrNamespaceContents.TMDefRec (tycons = []; bindings = bindings) -> - let inline isModule b = - match b with - | ModuleOrNamespaceBinding.Module _ -> true - | ModuleOrNamespaceBinding.Binding _ -> false - - // Don't add the path if it the current ModuleOrNamespace doesn't expose any types or bindings - if List.forall isModule bindings then - denv - else - denv.AddOpenPath (List.map fst innerPath) - | _ -> + if not (isConcreteNamespace def) then + denv + else denv.AddOpenPath (List.map fst innerPath) if mspec.IsImplicitNamespace then diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs index 62ee01c07d5..5051d595827 100644 --- a/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/ModuleOrNamespaceTests.fs @@ -5,7 +5,7 @@ open Xunit open FsUnit open FSharp.Test.Compiler -let inline private prependNewline v = String.Concat("\n", v) +let private prependNewline v = String.Concat("\n", v) let equal x = let x =