diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 27db98d802b..8d6cce1d743 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -3347,6 +3347,35 @@ let PostParseModuleSpecs (defaultNamespace,filename,isLastCompiland,ParsedSigFil ParsedInput.SigFile(ParsedSigFileInput(filename,qualName,scopedPragmas,hashDirectives,specs)) +/// Checks if a module name is already given and deduplicates the name if needed. +let DeduplicateModuleName (moduleNamesDict:Dictionary>) (paths: Set) path (qualifiedNameOfFile: QualifiedNameOfFile) = + let count = if paths.Contains path then paths.Count else paths.Count + 1 + moduleNamesDict.[qualifiedNameOfFile.Text] <- Set.add path paths + let id = qualifiedNameOfFile.Id + if count = 1 then qualifiedNameOfFile else QualifiedNameOfFile(Ident(id.idText + "___" + count.ToString(),id.idRange)) + +/// Checks if a ParsedInput is using a module name that was already given and deduplicates the name if needed. +let DeduplicateParsedInputModuleName (moduleNamesDict:Dictionary>) input = + match input with + | ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) -> + let path = Path.GetDirectoryName fileName + match moduleNamesDict.TryGetValue qualifiedNameOfFile.Text with + | true, paths -> + let qualifiedNameOfFile = DeduplicateModuleName moduleNamesDict paths path qualifiedNameOfFile + ParsedInput.ImplFile(ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) + | _ -> + moduleNamesDict.Add(qualifiedNameOfFile.Text,Set.singleton path) + input + | ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) -> + let path = Path.GetDirectoryName fileName + match moduleNamesDict.TryGetValue qualifiedNameOfFile.Text with + | true, paths -> + let qualifiedNameOfFile = DeduplicateModuleName moduleNamesDict paths path qualifiedNameOfFile + ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) + | _ -> + moduleNamesDict.Add(qualifiedNameOfFile.Text,Set.singleton path) + input + let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaultNamespace,filename,isLastCompiland) = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy filename diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 95b4e178bea..fa25170aeee 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -69,6 +69,12 @@ val ComputeQualifiedNameOfFileFromUniquePath : range * string list -> Ast.Qualif val PrependPathToInput : Ast.Ident list -> Ast.ParsedInput -> Ast.ParsedInput +/// Checks if a module name is already given and deduplicates the name if needed. +val DeduplicateModuleName : Dictionary> -> Set -> string -> Ast.QualifiedNameOfFile -> Ast.QualifiedNameOfFile + +/// Checks if a ParsedInput is using a module name that was already given and deduplicates the name if needed. +val DeduplicateParsedInputModuleName : Dictionary> -> Ast.ParsedInput -> Ast.ParsedInput + val ParseInput : (UnicodeLexing.Lexbuf -> Parser.token) * ErrorLogger * UnicodeLexing.Lexbuf * string option * string * isLastCompiland:(bool * bool) -> Ast.ParsedInput //---------------------------------------------------------------------------- diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 542a0c14ad4..5ff0f8fe19c 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -1764,35 +1764,9 @@ let main0(ctok, argv, referenceResolver, bannerAlreadyPrinted, exiter:Exiter, er let inputs = // Deduplicate module names - let seen = Dictionary>() - let deduplicate (paths: Set) path (qualifiedNameOfFile: QualifiedNameOfFile) = - let count = if paths.Contains path then paths.Count else paths.Count + 1 - seen.[qualifiedNameOfFile.Text] <- Set.add path paths - let id = qualifiedNameOfFile.Id - if count = 1 then qualifiedNameOfFile else QualifiedNameOfFile(Ident(id.idText + "___" + count.ToString(),id.idRange)) + let moduleNamesDict = Dictionary>() inputs - |> List.map (fun (input,x) -> - match input with - | ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) -> - let path = Path.GetDirectoryName fileName - match seen.TryGetValue qualifiedNameOfFile.Text with - | true, paths -> - let qualifiedNameOfFile = deduplicate paths path qualifiedNameOfFile - let input = ParsedInput.ImplFile(ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) - input,x - | _ -> - seen.Add(qualifiedNameOfFile.Text,Set.singleton path) - input,x - | ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) -> - let path = Path.GetDirectoryName fileName - match seen.TryGetValue qualifiedNameOfFile.Text with - | true, paths -> - let qualifiedNameOfFile = deduplicate paths path qualifiedNameOfFile - let input = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) - input,x - | _ -> - seen.Add(qualifiedNameOfFile.Text,Set.singleton path) - input,x) + |> List.map (fun (input,x) -> DeduplicateParsedInputModuleName moduleNamesDict input,x) if tcConfig.parseOnly then exiter.Exit 0 if not tcConfig.continueAfterParseFailure then diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index 04263de6880..c80a479055f 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1328,6 +1328,9 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let StampFileNameTask (cache: TimeStampCache) _ctok (_m:range, filename:string, _isLastCompiland) = assertNotDisposed() cache.GetFileTimeStamp filename + + // Deduplicate module names + let moduleNamesDict = Dictionary>() /// This is a build task function that gets placed into the build rules as the computation for a VectorMap /// @@ -1344,8 +1347,10 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed filename) - let result = ParseOneInputFile(tcConfig,lexResourceManager, [], filename ,isLastCompiland,errorLogger,(*retryLocked*)true) + let input = ParseOneInputFile(tcConfig,lexResourceManager, [], filename ,isLastCompiland,errorLogger,(*retryLocked*)true) fileParsed.Trigger (filename) + let result = Option.map (DeduplicateParsedInputModuleName moduleNamesDict) input + result,sourceRange,filename,errorLogger.GetErrors () with exn -> System.Diagnostics.Debug.Assert(false, sprintf "unexpected failure in IncrementalFSharpBuild.Parse\nerror = %s" (exn.ToString())) diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 22853d9b1dc..9599c609c59 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -4851,3 +4851,21 @@ let ``Test request for parse and check doesn't check whole project`` () = () +[] +// Simplified repro for https://github.com/Microsoft/visualfsharp/issues/2679 +let ``add files with same name from different folders`` () = + let fileNames = + [ __SOURCE_DIRECTORY__ + "/data/samename/folder1/a.fs" + __SOURCE_DIRECTORY__ + "/data/samename/folder2/a.fs" ] + let projFileName = __SOURCE_DIRECTORY__ + "/data/samename/tempet.fsproj" + let args = mkProjectCommandLineArgs ("test.dll", fileNames) + let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let wholeProjectResults = checker.ParseAndCheckProject(options) |> Async.RunSynchronously + let errors = + wholeProjectResults.Errors + |> Array.filter (fun x -> x.Severity = FSharpErrorSeverity.Error) + if errors.Length > 0 then + printfn "add files with same name from different folders" + for err in errors do + printfn "ERROR: %s" err.Message + shouldEqual 0 errors.Length \ No newline at end of file diff --git a/tests/service/data/samename/folder1/a.fs b/tests/service/data/samename/folder1/a.fs new file mode 100644 index 00000000000..7b1989e0200 --- /dev/null +++ b/tests/service/data/samename/folder1/a.fs @@ -0,0 +1,5 @@ +namespace tempet + +module SayA = + let hello name = + printfn "Hello %s" name \ No newline at end of file diff --git a/tests/service/data/samename/folder2/a.fs b/tests/service/data/samename/folder2/a.fs new file mode 100644 index 00000000000..dcb68b73836 --- /dev/null +++ b/tests/service/data/samename/folder2/a.fs @@ -0,0 +1,5 @@ +namespace tempet + +module SayB = + let hello name = + printfn "Hello %s" name \ No newline at end of file diff --git a/tests/service/data/samename/tempet.fsproj b/tests/service/data/samename/tempet.fsproj new file mode 100644 index 00000000000..8e647890c81 --- /dev/null +++ b/tests/service/data/samename/tempet.fsproj @@ -0,0 +1,13 @@ + + + netstandard1.6 + + + + + + + + + + \ No newline at end of file