Alignment with FCS to propagate specifier ranges in CheckFormatString.fs

Author: dsyme

src/fsharp/CheckFormatStrings.fs

@@ -8,6 +8,7 @@ open Microsoft.FSharp.Compiler.AbstractIL
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
 open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library 
 open Microsoft.FSharp.Compiler.Ast
+open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.ErrorLogger
 open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.Tastops
@@ -24,7 +25,7 @@ let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *)
 
 let mkFlexibleFormatTypar m tys dflt = 
     let tp = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m "fmt",HeadTypeStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
-    tp.FixupConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)];
+    tp.FixupConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)]
     copyAndFixupFormatTypar m tp
 
 let mkFlexibleIntFormatTypar g m = 
@@ -37,21 +38,46 @@ let mkFlexibleFloatFormatTypar g m =
 let isDigit c = ('0' <= c && c <= '9')
 
 type FormatInfoRegister = 
-  { mutable leftJustify    : bool; 
-    mutable numPrefixIfPos : char option;
-    mutable addZeros       : bool;
+  { mutable leftJustify    : bool 
+    mutable numPrefixIfPos : char option
+    mutable addZeros       : bool
     mutable precision      : bool}
 
 let newInfo ()= 
-  { leftJustify    = false;
-    numPrefixIfPos = None;
-    addZeros       = false;
+  { leftJustify    = false
+    numPrefixIfPos = None
+    addZeros       = false
     precision      = false}
 
-let parseFormatStringInternal m g fmt bty cty = 
+let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty = 
+    // Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote.
+    // We construct a new 'fmt' string since the current 'fmt' string doesn't distinguish between "\n" and escaped "\\n".
+    let (offset, fmt) = 
+        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.EndLine < positions.Length then
+                let startIndex = positions.[m.StartLine-1] + m.StartColumn
+                let endIndex = positions.[m.EndLine-1] + m.EndColumn - 1
+                if startIndex < length-3 && source.[startIndex..startIndex+2] = "\"\"\"" then
+                    (3, source.[startIndex+3..endIndex-3])
+                elif startIndex < length-2 && source.[startIndex..startIndex+1] = "@\"" then
+                    (2, source.[startIndex+2..endIndex-1])
+                else (1, source.[startIndex+1..endIndex-1])
+            else (1, fmt)
+        | None -> (1, fmt)
+
     let len = String.length fmt
 
-    let rec parseLoop acc i = 
+    let specifierLocations = ResizeArray()
+
+    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
@@ -60,11 +86,13 @@ let parseFormatStringInternal m g fmt bty cty =
                    failwithf "%s" <| FSComp.SR.forPositionalSpecifiersNotPermitted()
            argtys
        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()
@@ -73,58 +101,58 @@ let parseFormatStringInternal m g fmt bty cty =
                 if i >= len then failwithf "%s" <| FSComp.SR.forMissingFormatSpecifier()
                 match fmt.[i] with
                 | '-' -> 
-                    if info.leftJustify then failwithf "%s" <| FSComp.SR.forFlagSetTwice("-");
-                    info.leftJustify <- true;
+                    if info.leftJustify then failwithf "%s" <| FSComp.SR.forFlagSetTwice("-")
+                    info.leftJustify <- true
                     flags(i+1)
                 | '+' -> 
                     if info.numPrefixIfPos <> None then failwithf "%s" <| FSComp.SR.forPrefixFlagSpacePlusSetTwice()
-                    info.numPrefixIfPos <- Some '+';
+                    info.numPrefixIfPos <- Some '+'
                     flags(i+1)
                 | '0' -> 
-                    if info.addZeros then failwithf "%s" <| FSComp.SR.forFlagSetTwice("0");
-                    info.addZeros <- true;
+                    if info.addZeros then failwithf "%s" <| FSComp.SR.forFlagSetTwice("0")
+                    info.addZeros <- true
                     flags(i+1)
                 | ' ' -> 
-                    if info.numPrefixIfPos <> None then failwithf "%s" <| FSComp.SR.forPrefixFlagSpacePlusSetTwice();
-                    info.numPrefixIfPos <- Some ' ';
+                    if info.numPrefixIfPos <> None then failwithf "%s" <| FSComp.SR.forPrefixFlagSpacePlusSetTwice()
+                    info.numPrefixIfPos <- Some ' '
                     flags(i+1)
-                | '#' -> failwithf "%s" <| FSComp.SR.forHashSpecifierIsInvalid(); 
+                | '#' -> failwithf "%s" <| FSComp.SR.forHashSpecifierIsInvalid() 
                 | _ -> i
 
               let rec digitsPrecision i = 
-                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
+                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
                 match fmt.[i] with
                 | c when isDigit c -> digitsPrecision (i+1)
                 | _ -> i 
 
               let precision i = 
-                if i >= len then failwithf "%s" <| FSComp.SR.forBadWidth();
+                if i >= len then failwithf "%s" <| FSComp.SR.forBadWidth()
                 match fmt.[i] with
                 | c when isDigit c -> info.precision <- true; false,digitsPrecision (i+1)
                 | '*' -> info.precision <- true; true,(i+1)
                 | _ -> failwithf "%s" <| FSComp.SR.forPrecisionMissingAfterDot()
 
               let optionalDotAndPrecision i = 
-                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
+                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
                 match fmt.[i] with
                 | '.' -> precision (i+1)
                 | _ -> false,i
 
               let rec digitsWidthAndPrecision i = 
-                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
+                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
                 match fmt.[i] with
                 | c when isDigit c -> digitsWidthAndPrecision (i+1)
                 | _ -> optionalDotAndPrecision i
 
               let widthAndPrecision i = 
-                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
+                if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
                 match fmt.[i] with
                 | c when isDigit c -> false,digitsWidthAndPrecision i
                 | '*' -> true,optionalDotAndPrecision (i+1)
                 | _ -> false,optionalDotAndPrecision i
 
               let rec digitsPosition n i =
-                  if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
+                  if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
                   match fmt.[i] with
                   | c when isDigit c -> digitsPosition (n*10 + int c - int '0') (i+1)
                   | '$' -> Some n, i+1
@@ -136,14 +164,20 @@ let parseFormatStringInternal m g fmt bty cty =
                       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();
+              if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
 
               let acc = if precisionArg then (Option.map ((+)1) posi, g.int_ty) :: acc else acc 
 
@@ -155,20 +189,36 @@ let parseFormatStringInternal m g fmt bty cty =
                                               failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(c.ToString(), (Option.get info.numPrefixIfPos).ToString())
 
               let checkOtherFlags c = 
-                  checkNoPrecision c; 
-                  checkNoZeroFlag c; 
+                  checkNoPrecision c 
+                  checkNoZeroFlag c 
                   checkNoNumericPrefix c
 
+              let collectSpecifierLocation relLine relCol = 
+                  match relLine with
+                  | 0 ->
+                      specifierLocations.Add(
+                        Range.mkFileIndexRange m.FileIndex 
+                                (Range.mkPos m.StartLine (startCol + offset)) 
+                                (Range.mkPos m.StartLine (relCol + offset)))
+                  | _ ->
+                      specifierLocations.Add(
+                        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)
+                  if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
+                  collectSpecifierLocation 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());
+                  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 ..."
@@ -178,65 +228,79 @@ let parseFormatStringInternal m g fmt bty cty =
                   failwithf "%s" <| FSComp.SR.forLIsUnnecessary()
                   match fmt.[i] with
                   | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') -> 
-                      parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc)  (i+1)
+                      collectSpecifierLocation 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)
+                  collectSpecifierLocation 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') ->
+                  collectSpecifierLocation relLine relCol
+                  parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
 
               | 'b' ->
-                  checkOtherFlags ch;
-                  parseLoop ((posi, g.bool_ty)  :: acc) (i+1)
+                  checkOtherFlags ch
+                  collectSpecifierLocation relLine relCol
+                  parseLoop ((posi, g.bool_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 'c' ->
-                  checkOtherFlags ch;
-                  parseLoop ((posi, g.char_ty)  :: acc) (i+1)
+                  checkOtherFlags ch
+                  collectSpecifierLocation relLine relCol
+                  parseLoop ((posi, g.char_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 's' ->
-                  checkOtherFlags ch;
-                  parseLoop ((posi, g.string_ty)  :: acc) (i+1)
+                  checkOtherFlags ch
+                  collectSpecifierLocation relLine relCol
+                  parseLoop ((posi, g.string_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 'O' ->
-                  checkOtherFlags ch;
-                  parseLoop ((posi, NewInferenceType ()) :: acc)  (i+1)
+                  checkOtherFlags ch
+                  collectSpecifierLocation 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 '+' -> 
+                      collectSpecifierLocation 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;
+                  checkOtherFlags ch
                   let xty = NewInferenceType () 
                   let fty = bty --> (xty --> cty)
-                  parseLoop ((Option.map ((+)1) posi, xty) ::  (posi, fty) :: acc) (i+1)
+                  collectSpecifierLocation 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)
+                  checkOtherFlags ch
+                  collectSpecifierLocation 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
-
-let ParseFormatString m g fmt bty cty dty = 
-    let argtys = parseFormatStringInternal m g fmt bty cty
+          
+          | '\n' -> parseLoop acc (i+1, relLine+1, 0)   
+          | _ -> parseLoop acc (i+1, relLine, relCol+1)
+           
+    let results = parseLoop [] (0, 0, m.StartColumn)
+    results, Seq.toList specifierLocations
+
+let ParseFormatString m g source fmt bty cty dty = 
+    let argtys, specifierLocations = parseFormatStringInternal m g source fmt bty cty
     let aty = List.foldBack (-->) argtys dty
     let ety = mkTupledTy g argtys
-    aty, ety
+    (aty, ety), specifierLocations 
 
 let TryCountFormatStringArguments m g fmt bty cty =
     try
-        parseFormatStringInternal m g fmt bty cty
-        |> List.length
-        |> Some
+        let argtys, _specifierLocations = parseFormatStringInternal m g None fmt bty cty
+        Some argtys.Length
     with _ ->
-        None
+        None
+

src/fsharp/CheckFormatStrings.fsi

@@ -13,6 +13,6 @@ open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.TcGlobals
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
 
-val ParseFormatString : Range.range -> TcGlobals -> string -> TType -> TType -> TType -> TType * TType
+val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * Range.range list
 
 val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option

src/fsharp/TypeChecker.fs

@@ -6277,7 +6277,7 @@ 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 CheckFormatStrings.ParseFormatString m cenv.g s bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m)))
+        let (aty',ety'),_specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g None s 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