diff --git a/src/fsharp/formats.fs b/src/fsharp/formats.fs index 12e79af267..078eedb1b6 100755 --- a/src/fsharp/formats.fs +++ b/src/fsharp/formats.fs @@ -48,10 +48,31 @@ let newInfo ()= addZeros = false; precision = false} -let ParseFormatString m g fmt bty cty dty = +let ParseFormatString (m: Range.range) g (source: string option) report fmt bty cty dty = let len = String.length fmt - let rec parseLoop acc i = + // Offset to adjust ranges depending on whether input string is regular, verbatim or triple-quote + let offset = + match source with + | Some source -> + let source = source.Replace("\r\n", "\n").Replace("\r", "\n") + let positions = + source.Split('\n') + |> Seq.map (fun s -> String.length s + 1) + |> Seq.scan (+) 0 + |> Seq.toArray + let length = source.Length + if m.StartLine < positions.Length then + let startIndex = positions.[m.StartLine-1] + m.StartColumn + if startIndex <= length-3 && source.[startIndex..startIndex+2] = "\"\"\"" then + 3 + elif startIndex <= length-2 && source.[startIndex..startIndex+1] = "@\"" then + 2 + else 1 + else 1 + | None -> 1 + + let rec parseLoop acc (i, relLine, relCol) = if i >= len then let argtys = if acc |> List.forall (fun (p, _) -> p = None) then // without positional specifiers @@ -63,11 +84,13 @@ let ParseFormatString m g fmt bty cty dty = let ety = mkTupledTy g argtys aty,ety elif System.Char.IsSurrogatePair(fmt,i) then - parseLoop acc (i+2) + parseLoop acc (i+2, relLine, relCol+2) else let c = fmt.[i] match c with | '%' -> + let startCol = relCol + let relCol = relCol+1 let i = i+1 if i >= len then failwithf "%s" <| FSComp.SR.forMissingFormatSpecifier() let info = newInfo() @@ -139,12 +162,18 @@ let ParseFormatString m g fmt bty cty dty = let p, i' = digitsPosition (int c - int '0') (i+1) if p = None then None, i else p, i' | _ -> None, i - + + let oldI = i let posi, i = position i + let relCol = relCol + i - oldI + let oldI = i let i = flags i + let relCol = relCol + i - oldI + let oldI = i let widthArg,(precisionArg,i) = widthAndPrecision i + let relCol = relCol + i - oldI if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision(); @@ -162,16 +191,30 @@ let ParseFormatString m g fmt bty cty dty = checkNoZeroFlag c; checkNoNumericPrefix c + let reportLocation relLine relCol = + match relLine with + | 0 -> + report (Range.mkFileIndexRange m.FileIndex + (Range.mkPos m.StartLine (startCol + offset)) + (Range.mkPos m.StartLine (relCol + offset))) + | _ -> + report (Range.mkFileIndexRange m.FileIndex + (Range.mkPos (m.StartLine + relLine) startCol) + (Range.mkPos (m.StartLine + relLine) relCol)) + let ch = fmt.[i] match ch with - | '%' -> parseLoop acc (i+1) + | '%' -> + parseLoop acc (i+1, relLine, relCol+1) | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') -> if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString()); - parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1) | ('l' | 'L') -> if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString()); + let relCol = relCol+1 let i = i+1 // "bad format specifier ... In F# code you can use %d, %x, %o or %u instead ..." @@ -181,52 +224,64 @@ let ParseFormatString m g fmt bty cty dty = failwithf "%s" <| FSComp.SR.forLIsUnnecessary() match fmt.[i] with | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') -> - parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1) | _ -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifier() | ('h' | 'H') -> failwithf "%s" <| FSComp.SR.forHIsUnnecessary() | 'M' -> - parseLoop ((posi, g.decimal_ty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, g.decimal_ty) :: acc) (i+1, relLine, relCol+1) - | ('f' | 'F' | 'e' | 'E' | 'g' | 'G') -> - parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1) + | ('f' | 'F' | 'e' | 'E' | 'g' | 'G') -> + reportLocation relLine relCol + parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1) | 'b' -> checkOtherFlags ch; - parseLoop ((posi, g.bool_ty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, g.bool_ty) :: acc) (i+1, relLine, relCol+1) | 'c' -> checkOtherFlags ch; - parseLoop ((posi, g.char_ty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, g.char_ty) :: acc) (i+1, relLine, relCol+1) | 's' -> checkOtherFlags ch; - parseLoop ((posi, g.string_ty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, g.string_ty) :: acc) (i+1, relLine, relCol+1) | 'O' -> checkOtherFlags ch; - parseLoop ((posi, NewInferenceType ()) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1) | 'A' -> match info.numPrefixIfPos with | None // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic - | Some '+' -> parseLoop ((posi, NewInferenceType ()) :: acc) (i+1) + | Some '+' -> + reportLocation relLine relCol + parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1) | Some _ -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(ch.ToString(), (Option.get info.numPrefixIfPos).ToString()) | 'a' -> checkOtherFlags ch; let xty = NewInferenceType () let fty = bty --> (xty --> cty) - parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) (i+1, relLine, relCol+1) | 't' -> checkOtherFlags ch; - parseLoop ((posi, bty --> cty) :: acc) (i+1) + reportLocation relLine relCol + parseLoop ((posi, bty --> cty) :: acc) (i+1, relLine, relCol+1) | c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c) - - | _ -> parseLoop acc (i+1) - parseLoop [] 0 + + | '\n' -> parseLoop acc (i+1, relLine+1, 0) + | _ -> parseLoop acc (i+1, relLine, relCol+1) + parseLoop [] (0, 0, m.StartColumn) diff --git a/src/fsharp/formats.fsi b/src/fsharp/formats.fsi index 1016ef34cc..4d6c547ee9 100755 --- a/src/fsharp/formats.fsi +++ b/src/fsharp/formats.fsi @@ -12,4 +12,4 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.AbstractIL.Internal -val ParseFormatString : Range.range -> Env.TcGlobals -> string -> TType -> TType -> TType -> TType * TType +val ParseFormatString : Range.range -> Env.TcGlobals -> string option -> (Range.range -> unit) -> string -> TType -> TType -> TType -> TType * TType diff --git a/src/fsharp/nameres.fs b/src/fsharp/nameres.fs index 14d54067bf..50da1e1cdd 100755 --- a/src/fsharp/nameres.fs +++ b/src/fsharp/nameres.fs @@ -1098,6 +1098,8 @@ type ITypecheckResultsSink = abstract NotifyEnvWithScope : range * NameResolutionEnv * AccessorDomain -> unit abstract NotifyExprHasType : pos * TType * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit + abstract NotifyFormatSpecifierLocation : range -> unit + abstract CurrentSource : string option let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef @@ -1292,7 +1294,7 @@ type TcResolutions /// Represents container for all name resolutions that were met so far when typechecking some particular file -type TcSymbolUses(g,capturedNameResolutions : ResizeArray) = +type TcSymbolUses(g, capturedNameResolutions : ResizeArray, formatSpecifierLocations: range[]) = member this.GetUsesOfSymbol(item) = [| for cnr in capturedNameResolutions do @@ -1303,11 +1305,15 @@ type TcSymbolUses(g,capturedNameResolutions : ResizeArray() let capturedExprTypings = ResizeArray<_>() let capturedNameResolutions = ResizeArray<_>() + let capturedFormatSpecifierLocations = ResizeArray<_>() let capturedNameResolutionIdentifiers = new System.Collections.Generic.Dictionary ( { new IEqualityComparer<_> with @@ -1320,15 +1326,17 @@ type TcResultsSinkImpl(g) = TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions) member this.GetSymbolUses() = - TcSymbolUses(g, capturedNameResolutions) + TcSymbolUses(g, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray()) interface ITypecheckResultsSink with member sink.NotifyEnvWithScope(m,nenv,ad) = if allowedRange m then capturedEnvs.Add((m,nenv,ad)) + member sink.NotifyExprHasType(endPos,ty,denv,nenv,ad,m) = if allowedRange m then capturedExprTypings.Add((endPos,ty,denv,nenv,ad,m)) + member sink.NotifyNameResolution(endPos,item,itemMethodGroup,occurenceType,denv,nenv,ad,m) = // Desugaring some F# constructs (notably computation expressions with custom operators) // results in duplication of textual variables. So we ensure we never record two name resolutions @@ -1352,6 +1360,11 @@ type TcResultsSinkImpl(g) = capturedNameResolutions.Add(CapturedNameResolution(endPos,item,occurenceType,denv,nenv,ad,m)) capturedMethodGroupResolutions.Add(CapturedNameResolution(endPos,itemMethodGroup,occurenceType,denv,nenv,ad,m)) + member sink.NotifyFormatSpecifierLocation(m) = + capturedFormatSpecifierLocations.Add(m) + + member sink.CurrentSource = source + /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. diff --git a/src/fsharp/nameres.fsi b/src/fsharp/nameres.fsi index fcd5518bad..28f6a7ce27 100755 --- a/src/fsharp/nameres.fsi +++ b/src/fsharp/nameres.fsi @@ -228,14 +228,19 @@ type internal TcSymbolUses = member GetAllUsesOfSymbols : unit -> (Item * ItemOccurence * DisplayEnv * range)[] + member GetFormatSpecifierLocations : unit -> range[] + + /// An abstract type for reporting the results of name resolution and type checking type ITypecheckResultsSink = abstract NotifyEnvWithScope : range * NameResolutionEnv * AccessorDomain -> unit abstract NotifyExprHasType : pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit + abstract NotifyFormatSpecifierLocation : range -> unit + abstract CurrentSource : string option type internal TcResultsSinkImpl = - new : tcGlobals : TcGlobals -> TcResultsSinkImpl + new : tcGlobals : TcGlobals * ?source:string -> TcResultsSinkImpl member GetResolutions : unit -> TcResolutions member GetSymbolUses : unit -> TcSymbolUses interface ITypecheckResultsSink diff --git a/src/fsharp/tc.fs b/src/fsharp/tc.fs index 2bd6527694..515f2f96e7 100755 --- a/src/fsharp/tc.fs +++ b/src/fsharp/tc.fs @@ -1712,7 +1712,9 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = { new ITypecheckResultsSink with member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports member this.NotifyNameResolution(pos, a, b, occurence, denv, nenv, ad, m) = nameResolutions.Add(pos, a, b, occurence, denv, nenv, ad, m) - member this.NotifyExprHasType(_, _, _, _, _, _) = assert false } // no expr typings in MakeSimpleVals + member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeSimpleVals + member this.NotifyFormatSpecifierLocation _ = () + member this.CurrentSource = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) MakeSimpleVals cenv env names @@ -6211,7 +6213,10 @@ and TcConstStringExpr cenv overallTy env m tpenv s = let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then // Parse the format string to work out the phantom types - let aty',ety' = (try Formats.ParseFormatString m cenv.g s bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + let report m = match cenv.tcSink.CurrentSink with None -> () | Some sink -> sink.NotifyFormatSpecifierLocation m + let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource + + let aty',ety' = (try Formats.ParseFormatString m cenv.g source report (s.Replace("\r\n", "\n").Replace("\r", "\n")) bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) UnifyTypes cenv env m aty aty' UnifyTypes cenv env m ety ety' mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 93a02c4e09..b93abe4e17 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1197,6 +1197,9 @@ type TypeCheckInfo [ for x in tcImports.GetImportedAssemblies() do yield FSharpAssembly(g, thisCcu, tcImports, x.FSharpViewOfMetadata) ] + // Not, this does not have to be a SyncOp, it can be called from any thread + member scope.GetFormatSpecifierLocations() = + sSymbolUses.GetFormatSpecifierLocations() // Not, this does not have to be a SyncOp, it can be called from any thread member scope.GetExtraColorizations() = @@ -1499,7 +1502,7 @@ module internal Parser = tcState.NiceNameGenerator.Reset() // Typecheck the real input. - let sink = TcResultsSinkImpl(tcGlobals) + let sink = TcResultsSinkImpl(tcGlobals, source = source) let tcEnvAtEndOpt = try @@ -1790,6 +1793,13 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo |> Option.map (fun (sym,_,_) -> sym)) + member info.GetFormatSpecifierLocations() = + threadSafeOp + (fun () -> [| |]) + (fun (scope, _builder, _reactor) -> + // This operation is not asynchronous - GetFormatSpecifierLocations can be run on the calling thread + scope.GetFormatSpecifierLocations()) + member info.GetExtraColorizationsAlternate() = threadSafeOp (fun () -> [| |]) diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 2fe350561d..5f7c8a9a60 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -246,6 +246,9 @@ type FSharpCheckFileResults = /// Get any extra colorization info that is available after the typecheck member GetExtraColorizationsAlternate : unit -> (range * FSharpTokenColorKind)[] + /// Get the locations of format specifiers + member GetFormatSpecifierLocations : unit -> range[] + /// Get all textual usages of all symbols throughout the file member GetAllUsesOfAllSymbolsInFile : unit -> Async diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index 23de213668..09051403fb 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -323,4 +323,89 @@ type Test() = let decls = typeCheckResults.GetDeclarationListSymbols(Some untyped, 4, 15, inputLines.[3], [], "", fun _ -> false)|> Async.RunSynchronously decls|> Seq .exists (fun d -> d.Head.DisplayName = "abc") |> shouldEqual true + +[] +let ``Printf specifiers for regular and verbatim strings`` () = + let input = + """ +let _ = Microsoft.FSharp.Core.Printf.printf "%A" 0 +let _ = Printf.printf "%A" 0 +let _ = Printf.kprintf (fun _ -> ()) "%A" 1 +let _ = Printf.bprintf null "%A" 1 +let _ = sprintf "%*d" 1 +let _ = sprintf "%7.1f" 1.0 +let _ = sprintf "%-8.1e+567" 1.0 +let _ = sprintf @"%-5s" "value" +let _ = printfn @"%-A" -10 +let _ = printf @" + %-O" -10 +let _ = sprintf " + + %-O" -10 +let _ = List.map (sprintf @"%A + ") +let _ = (10, 12) ||> sprintf "%A + %O" +""" + + let file = "/home/user/Test.fsx" + let untyped, typeCheckResults = parseAndTypeCheckFileInProject(file, input) + + typeCheckResults.Errors |> shouldEqual [||] + typeCheckResults.GetFormatSpecifierLocations() + |> Array.map (fun range -> range.StartLine, range.StartColumn, range.EndLine, range.EndColumn) + |> shouldEqual [|(2, 45, 2, 46); + (3, 23, 3, 24); + (4, 38, 4, 39); + (5, 29, 5, 30); + (6, 17, 6, 19); + (7, 17, 7, 21); + (8, 17, 8, 22); + (9, 18, 9, 21); + (10, 18, 10, 20); + (12, 12, 12, 14); + (15, 12, 15, 14); + (16, 28, 16, 29); + (18, 30, 18, 31); + (19, 30, 19, 31)|] + +[] +let ``Printf specifiers for triple-quote strings`` () = + let input = + " +let _ = sprintf \"\"\"%-A\"\"\" -10 +let _ = printfn \"\"\" + %-A + \"\"\" -10 +let _ = List.iter(printfn \"\"\"%-A + + \"\"\") +" + + let file = "/home/user/Test.fsx" + let untyped, typeCheckResults = parseAndTypeCheckFileInProject(file, input) + + typeCheckResults.Errors |> shouldEqual [||] + typeCheckResults.GetFormatSpecifierLocations() + |> Array.map (fun range -> range.StartLine, range.StartColumn, range.EndLine, range.EndColumn) + |> shouldEqual [|(2, 19, 2, 21); + (4, 12, 4, 14); + (6, 29, 6, 31)|] +[] +let ``Printf specifiers for user-defined functions`` () = + let input = + """ +let debug msg = Printf.kprintf System.Diagnostics.Debug.WriteLine msg +let _ = debug "Message: %i - %O" 1 "Ok" +""" + + let file = "/home/user/Test.fsx" + let untyped, typeCheckResults = parseAndTypeCheckFileInProject(file, input) + + typeCheckResults.Errors |> shouldEqual [||] + typeCheckResults.GetFormatSpecifierLocations() + |> Array.map (fun range -> range.StartLine, range.StartColumn, range.EndLine, range.EndColumn) + |> shouldEqual [|(3, 24, 3, 25); + (3, 29, 3, 30)|] + \ No newline at end of file