diff --git a/src/Compiler/Utilities/range.fs b/src/Compiler/Utilities/range.fs index 678ab07f452..bbeb8fb954e 100755 --- a/src/Compiler/Utilities/range.fs +++ b/src/Compiler/Utilities/range.fs @@ -7,6 +7,7 @@ open System open System.IO open System.Collections.Concurrent open System.Collections.Generic +open System.Text open Microsoft.FSharp.Core.Printf open Internal.Utilities.Library open Internal.Utilities.Library.Extras.Bits @@ -258,6 +259,13 @@ module FileIndex = let startupFileName = "startup" let commandLineArgsFileName = "commandLineArgs" + let mutable internal testSource: string option = None + + let internal setTestSource source = + testSource <- Some source + { new IDisposable with + member this.Dispose() = testSource <- None } + [] [ {DebugCode}")>] type Range(code1: int64, code2: int64) = @@ -342,6 +350,22 @@ type Range(code1: int64, code2: int64) = member _.Code2 = code2 member m.DebugCode = + let getRangeSubstring (m: range) (stream: Stream) = + let endCol = m.EndColumn - 1 + let startCol = m.StartColumn - 1 + + stream.ReadLines() + |> Seq.skip (m.StartLine - 1) + |> Seq.take (m.EndLine - m.StartLine + 1) + |> String.concat "\n" + |> fun s -> s.Substring(startCol + 1, s.LastIndexOf("\n", StringComparison.Ordinal) + 1 - startCol + endCol) + + match testSource with + | Some source -> + use stream = new MemoryStream(Encoding.UTF8.GetBytes(source + "\n")) + getRangeSubstring m stream + | _ -> + let name = m.FileName if @@ -351,21 +375,14 @@ type Range(code1: int64, code2: int64) = then name else - try - let endCol = m.EndColumn - 1 - let startCol = m.StartColumn - 1 - if FileSystem.IsInvalidPathShim m.FileName then "path invalid: " + m.FileName elif not (FileSystem.FileExistsShim m.FileName) then "non existing file: " + m.FileName else - FileSystem.OpenFileForReadShim(m.FileName).ReadLines() - |> Seq.skip (m.StartLine - 1) - |> Seq.take (m.EndLine - m.StartLine + 1) - |> String.concat "\n" - |> fun s -> s.Substring(startCol + 1, s.LastIndexOf("\n", StringComparison.Ordinal) + 1 - startCol + endCol) + use stream = FileSystem.OpenFileForReadShim(m.FileName) + getRangeSubstring m stream with e -> e.ToString() diff --git a/src/Compiler/Utilities/range.fsi b/src/Compiler/Utilities/range.fsi index 7b422fcd307..d3a53f2ace0 100755 --- a/src/Compiler/Utilities/range.fsi +++ b/src/Compiler/Utilities/range.fsi @@ -3,6 +3,7 @@ // The Range and Pos types form part of the public API of FSharp.Compiler.Service namespace FSharp.Compiler.Text +open System open System.Collections.Generic /// An index into a global tables of filenames @@ -183,6 +184,9 @@ module internal FileIndex = val startupFileName: string + val mutable internal testSource: string option + val internal setTestSource: string -> IDisposable + module Range = /// Ordering on positions diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 8516948626a..4905e868099 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -361,10 +361,24 @@ let getParseAndCheckResultsPreview (source: string) = let getParseAndCheckResults50 (source: string) = parseAndCheckScript50("Test.fsx", source) +let parseTestSource () = + match FileIndex.testSource with + | None -> failwith "Test source is not set" + | Some source -> + + let path = "Test.fsx" + + let options = + { FSharpParsingOptions.Default with + IsExe = true + SourceFiles = [| path |] } + + let parseFileResults = checker.ParseFile(path, SourceText.ofString source, options) |> Async.RunSynchronously + parseFileResults.ParseTree + let getParseAndCheckResults70 (source: string) = parseAndCheckScript70("Test.fsx", source) - let inline dumpDiagnostics (results: FSharpCheckFileResults) = results.Diagnostics |> Array.map (fun e -> diff --git a/tests/service/ParserTests.fs b/tests/service/ParserTests.fs index cb531801314..5a3ff116b21 100644 --- a/tests/service/ParserTests.fs +++ b/tests/service/ParserTests.fs @@ -8,14 +8,14 @@ open NUnit.Framework [] let ``Interface impl - No members`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ type T = interface I with member x.P2 = () let x = () """ - match getSingleModuleMemberDecls parseResults with + match parseTestSource () |> getSingleModuleMemberDecls with | [ SynModuleDecl.Types ([ SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members = [ _; _ ])) ], _) SynModuleDecl.Let _ ] -> () | _ -> failwith "Unexpected tree" @@ -23,7 +23,7 @@ let x = () [] let ``Union case 01 - of`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ type U1 = | A of @@ -39,7 +39,7 @@ let x = () cases |> List.map (fun (SynUnionCase (ident = SynIdent(ident,_))) -> ident.idText) |> Some | _ -> None - match getSingleModuleMemberDecls parseResults with + match parseTestSource () |> getSingleModuleMemberDecls with | [ SynModuleDecl.Types ([ UnionWithCases ["A"]], _) SynModuleDecl.Types ([ UnionWithCases ["B"; "C"] ], _) SynModuleDecl.Let _ ] -> () @@ -48,72 +48,72 @@ let x = () [] let ``Match clause 01`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | x """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) ]) -> () | _ -> failwith "Unexpected tree" [] let ``Match clause 02 - When`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | x when true """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) ]) -> () | _ -> failwith "Unexpected tree" [] let ``Match clause 03 - When`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | x when true | _ -> () """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _); _ ]) -> () | _ -> failwith "Unexpected tree" [] let ``Match clause 04 - Or pat`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | x | _ -> () """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (pat=SynPat.Or _;resultExpr=SynExpr.Const _) ]) -> () | _ -> failwith "Unexpected tree" [] let ``Match clause 05 - Missing body`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | x -> | _ -> () """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (resultExpr=SynExpr.ArbitraryAfterError _) SynMatchClause (resultExpr=SynExpr.Const _) ]) -> () | _ -> failwith "Unexpected tree" [] let ``Match clause 06`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | (x | y -> () """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (pat=pat) ]) -> match pat with | SynPat.FromParseError (SynPat.Paren (SynPat.Or (SynPat.Named _, SynPat.Named _, _, _), _), _) -> () @@ -122,13 +122,13 @@ match () with [] let ``Match clause 07`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | (x, | y -> () """ - match getSingleExprInModule parseResults with + match parseTestSource () |> getSingleExprInModule with | SynExpr.Match (clauses=[ SynMatchClause (pat=pat) ]) -> match pat with | SynPat.Paren(SynPat.Or(SynPat.Tuple(elementPats = [SynPat.Named _; SynPat.Wild _]), SynPat.Named _, _, _), _) -> () @@ -137,12 +137,12 @@ match () with [] let ``Match clause 08 - Range`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ match () with | a b """ - match getSingleModuleMemberDecls parseResults with + match parseTestSource () |> getSingleModuleMemberDecls with | [ SynModuleDecl.Expr (expr=(SynExpr.Match _ as m)); SynModuleDecl.Expr (expr=(SynExpr.Ident _ as i)) ] -> Assert.True(Position.posLt m.Range.End i.Range.Start) | _ -> failwith "Unexpected tree" @@ -150,11 +150,11 @@ b [] let ``Let - Parameter - Paren 01`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ let f (x """ - match getSingleDeclInModule parseResults with + match parseTestSource () |> getSingleDeclInModule with | SynModuleDecl.Let (_, [ SynBinding (headPat = headPat) ], _) -> match headPat with | SynPat.LongIdent (argPats=SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Named _, _), _) ]) -> () @@ -163,11 +163,11 @@ let f (x [] let ``Let - Parameter - Paren 02 - Tuple`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ let f (x, y """ - match getSingleDeclInModule parseResults with + match parseTestSource () |> getSingleDeclInModule with | SynModuleDecl.Let (_, [ SynBinding (headPat = headPat) ], _) -> match headPat with | SynPat.LongIdent (argPats=SynArgPats.Pats [ SynPat.FromParseError (SynPat.Paren (SynPat.Tuple _, _), _) ]) -> () @@ -176,11 +176,11 @@ let f (x, y [] let ``Let - Parameter - Paren 03 - Tuple`` () = - let parseResults = getParseResults """ + use _ = FileIndex.setTestSource """ let f (x, """ - match getSingleDeclInModule parseResults with + match parseTestSource () |> getSingleDeclInModule with | SynModuleDecl.Let (_, [ SynBinding (headPat = SynPat.LongIdent (argPats = SynArgPats.Pats [ pat ])) ], _) -> match pat with | SynPat.FromParseError (SynPat.Paren (SynPat.Tuple(elementPats = [SynPat.Named _; SynPat.Wild _]), _), _) -> ()