potential fix for 5932

src/fsharp/range.fs

@@ -5,7 +5,6 @@ module Microsoft.FSharp.Compiler.Range
 
 open System
 open System.IO
-open System.Collections.Generic
 open System.Collections.Concurrent
 open Microsoft.FSharp.Core.Printf
 open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
@@ -16,17 +15,20 @@ type FileIndex = int32
 
 [<Literal>]
 let columnBitCount = 20
+
 [<Literal>]
 let lineBitCount = 31
 
 let posBitCount = lineBitCount + columnBitCount
-let _ = assert (posBitCount <= 64)
+
 let posColumnMask  = mask64 0 columnBitCount
+
 let lineColumnMask = mask64 columnBitCount lineBitCount
 
 [<Struct; CustomEquality; NoComparison>]
 [<System.Diagnostics.DebuggerDisplay("{Line},{Column}")>]
 type pos(code:int64) =
+
     new (l, c) = 
         let l = max 0 l 
         let c = max 0 c 
@@ -35,63 +37,80 @@ type pos(code:int64) =
         pos p
 
     member p.Line = int32 (uint64 code >>> columnBitCount)
+
     member p.Column = int32 (code &&& posColumnMask)
 
     member r.Encoding = code
+
     static member EncodingSize = posBitCount
+
     static member Decode (code:int64) : pos = pos code
+
     override p.Equals(obj) = match obj with :? pos as p2 -> code = p2.Encoding | _ -> false
+
     override p.GetHashCode() = hash code
+
     override p.ToString() = sprintf "(%d,%d)" p.Line p.Column
 
 [<Literal>]
 let fileIndexBitCount = 24
+
 [<Literal>]
 let startColumnBitCount = columnBitCount // 20
+
 [<Literal>]
 let endColumnBitCount = columnBitCount // 20
 
 [<Literal>]
 let startLineBitCount = lineBitCount // 31
+
 [<Literal>]
 let heightBitCount = 27
+
 [<Literal>]
 let isSyntheticBitCount = 1
-#if DEBUG
-let _ = assert (fileIndexBitCount + startColumnBitCount + endColumnBitCount <= 64)
-let _ = assert (startLineBitCount + heightBitCount + isSyntheticBitCount <= 64)
-#endif
-
+
 [<Literal>]
 let fileIndexShift   = 0 
+
 [<Literal>]
 let startColumnShift = 24
+
 [<Literal>]
 let endColumnShift   = 44
 
 [<Literal>]
 let startLineShift   = 0
+
 [<Literal>]
 let heightShift      = 31
+
 [<Literal>]
 let isSyntheticShift = 58
 
-
 [<Literal>]
 let fileIndexMask =   0b0000000000000000000000000000000000000000111111111111111111111111L
+
 [<Literal>]
 let startColumnMask = 0b0000000000000000000011111111111111111111000000000000000000000000L
+
 [<Literal>]
 let endColumnMask =   0b1111111111111111111100000000000000000000000000000000000000000000L
 
 [<Literal>]
 let startLineMask =   0b0000000000000000000000000000000001111111111111111111111111111111L
+
 [<Literal>]
 let heightMask =      0b0000001111111111111111111111111110000000000000000000000000000000L
+
 [<Literal>]
 let isSyntheticMask = 0b0000010000000000000000000000000000000000000000000000000000000000L
 
 #if DEBUG
+let _ = assert (posBitCount <= 64)
+let _ = assert (fileIndexBitCount + startColumnBitCount + endColumnBitCount <= 64)
+let _ = assert (startLineBitCount + heightBitCount + isSyntheticBitCount <= 64)
+
 let _ = assert (startColumnShift   = fileIndexShift   + fileIndexBitCount)
 let _ = assert (endColumnShift = startColumnShift   + startColumnBitCount)
 
@@ -106,24 +125,64 @@ let _ = assert (endColumnMask =   mask64 endColumnShift   endColumnBitCount)
 let _ = assert (isSyntheticMask = mask64 isSyntheticShift isSyntheticBitCount)
 #endif
 
-// This is just a standard unique-index table
+/// Removes relative parts from any full paths
+let normalizeFilePath (filePath: string) = 
+    try 
+        if FileSystem.IsPathRootedShim filePath then 
+            FileSystem.GetFullPathShim filePath
+        else
+            filePath
+    with _ -> filePath
+
+/// A unique-index table for file names.
 type FileIndexTable() = 
     let indexToFileTable = new ResizeArray<_>(11)
     let fileToIndexTable = new ConcurrentDictionary<string, int>()
-    member t.FileToIndex f = 
-        let mutable res = 0 
-        let ok = fileToIndexTable.TryGetValue(f, &res) 
-        if ok then res 
-        else
+
+    // Note: we should likely adjust this code to always normalize. However some testing (and possibly some
+    // product behaviour) appears to be sensitive to error messages reporting un-normalized file names.
+    // Currently all names going through 'mkRange' get normalized, while this going through just 'fileIndexOfFile'
+    // do not.  Also any file names which are not put into ranges at all are non-normalized.
+    //
+    // TO move forward we should eventually introduce a new type NormalizedFileName that tracks this invariant.
+    member t.FileToIndex normalize filePath = 
+        match fileToIndexTable.TryGetValue(filePath) with 
+        | true, idx -> idx
+        | _ -> 
+
+        // Try again looking for a normalized entry.
+        let normalizedFilePath = if normalize then normalizeFilePath filePath else filePath
+        match fileToIndexTable.TryGetValue(normalizedFilePath) with 
+        | true, idx ->
+            // Record the non-normalized entry if necessary
+            if filePath <> normalizedFilePath then 
+                lock fileToIndexTable (fun () -> 
+                    fileToIndexTable.[filePath] <- idx)
+
+            // Return the index
+            idx
+
+        | _ -> 
             lock fileToIndexTable (fun () -> 
-                let n = indexToFileTable.Count in
-                indexToFileTable.Add(f)
-                fileToIndexTable.[f] <- n
-                n)
+                // Get the new index
+                let idx = indexToFileTable.Count
+
+                // Record the normalized entry
+                indexToFileTable.Add normalizedFilePath
+                fileToIndexTable.[normalizedFilePath] <- idx
+
+                // Record the non-normalized entry if necessary
+                if filePath <> normalizedFilePath then 
+                    fileToIndexTable.[filePath] <- idx
+
+                // Return the index
+                idx)
 
     member t.IndexToFile n = 
-        (if n < 0 then failwithf "fileOfFileIndex: negative argument: n = %d\n" n)
-        (if n >= indexToFileTable.Count then failwithf "fileOfFileIndex: invalid argument: n = %d\n" n)
+        if n < 0 then 
+            failwithf "fileOfFileIndex: negative argument: n = %d\n" n
+        if n >= indexToFileTable.Count then
+            failwithf "fileOfFileIndex: invalid argument: n = %d\n" n
         indexToFileTable.[n]
 
 let maxFileIndex = pown32 fileIndexBitCount
@@ -133,8 +192,11 @@ let maxFileIndex = pown32 fileIndexBitCount
 let fileIndexTable = new FileIndexTable()
 
 // If we exceed the maximum number of files we'll start to report incorrect file names
-let fileIndexOfFile f = fileIndexTable.FileToIndex(f) % maxFileIndex 
-let fileOfFileIndex n = fileIndexTable.IndexToFile(n)
+let fileIndexOfFileAux normalize f = fileIndexTable.FileToIndex normalize f % maxFileIndex 
+
+let fileIndexOfFile filePath = fileIndexOfFileAux false filePath 
+
+let fileOfFileIndex idx = fileIndexTable.IndexToFile idx
 
 let mkPos l c = pos (l, c)
 
@@ -158,19 +220,31 @@ type range(code1:int64, code2: int64) =
     new (fidx, b:pos, e:pos) = range(fidx, b.Line, b.Column, e.Line, e.Column)
 
     member r.StartLine   = int32((code2 &&& startLineMask)   >>> startLineShift)
+
     member r.StartColumn = int32((code1 &&& startColumnMask) >>> startColumnShift) 
+
     member r.EndLine     = int32((code2 &&& heightMask)      >>> heightShift) + r.StartLine
+
     member r.EndColumn   = int32((code1 &&& endColumnMask)   >>> endColumnShift)
+
     member r.IsSynthetic = int32((code2 &&& isSyntheticMask) >>> isSyntheticShift) <> 0 
+
     member r.Start = pos (r.StartLine, r.StartColumn)
+
     member r.End = pos (r.EndLine, r.EndColumn)
+
     member r.FileIndex = int32(code1 &&& fileIndexMask)
+
     member m.StartRange = range (m.FileIndex, m.Start, m.Start)
+
     member m.EndRange = range (m.FileIndex, m.End, m.End)
+
     member r.FileName = fileOfFileIndex r.FileIndex
+
     member r.MakeSynthetic() = range(code1, code2 ||| isSyntheticMask)
 
     member r.Code1 = code1
+
     member r.Code2 = code2
 
 #if DEBUG
@@ -195,30 +269,28 @@ type range(code1:int64, code2: int64) =
 
     override r.ToString() = sprintf "%s (%d,%d--%d,%d) IsSynthetic=%b" r.FileName r.StartLine r.StartColumn r.EndLine r.EndColumn r.IsSynthetic
 
-let mkRange f b e =
-    // remove relative parts from full path
-    let normalizedFilePath = if FileSystem.IsPathRootedShim f then try FileSystem.GetFullPathShim f with _ -> f else f
-    range (fileIndexOfFile normalizedFilePath, b, e)
+let mkRange filePath startPos endPos = range (fileIndexOfFileAux true filePath, startPos, endPos)
 
-let mkFileIndexRange fi b e = range (fi, b, e)
+let mkFileIndexRange fileIndex startPos endPos = range (fileIndex, startPos, endPos)
 
-(* end representation, start derived ops *)
-
 let posOrder   = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order, Int32.order))
-(* rangeOrder: not a total order, but enough to sort on ranges *)      
+
+/// rangeOrder: not a total order, but enough to sort on ranges
 let rangeOrder = Order.orderOn (fun (r:range) -> r.FileName, r.Start) (Pair.order (String.order, posOrder))
 
 let outputPos   (os:TextWriter) (m:pos)   = fprintf os "(%d,%d)" m.Line m.Column
+
 let outputRange (os:TextWriter) (m:range) = fprintf os "%s%a-%a" m.FileName outputPos m.Start outputPos m.End
-let boutputPos   os (m:pos)   = bprintf os "(%d,%d)" m.Line m.Column
-let boutputRange os (m:range) = bprintf os "%s%a-%a" m.FileName boutputPos m.Start boutputPos m.End
 
 let posGt (p1:pos) (p2:pos) = (p1.Line > p2.Line || (p1.Line = p2.Line && p1.Column > p2.Column))
+
 let posEq (p1:pos) (p2:pos) = (p1.Line = p2.Line &&  p1.Column = p2.Column)
+
 let posGeq p1 p2 = posEq p1 p2 || posGt p1 p2
+
 let posLt p1 p2 = posGt p2 p1
 
-// This is deliberately written in an allocation-free way, i.e. m1.Start, m1.End etc. are not called
+/// This is deliberately written in an allocation-free way, i.e. m1.Start, m1.End etc. are not called
 let unionRanges (m1:range) (m2:range) = 
     if m1.FileIndex <> m2.FileIndex then m2 else
     let b = 
@@ -242,9 +314,13 @@ let rangeBeforePos (m1:range) p =
     posGeq p m1.End
 
 let rangeN filename line = mkRange filename (mkPos line 0) (mkPos line 0)
+
 let pos0 = mkPos 1 0
+
 let range0 =  rangeN "unknown" 1
+
 let rangeStartup = rangeN "startup" 1
+
 let rangeCmdArgs = rangeN "commandLineArgs" 0
 
 let trimRangeToLine (r:range) =
@@ -258,6 +334,7 @@ let trimRangeToLine (r:range) =
 
 (* For Diagnostics *)
 let stringOfPos   (pos:pos) = sprintf "(%d,%d)" pos.Line pos.Column
+
 let stringOfRange (r:range) = sprintf "%s%s-%s" r.FileName (stringOfPos r.Start) (stringOfPos r.End)
 
 #if CHECK_LINE0_TYPES // turn on to check that we correctly transform zero-based line counts to one-based line counts
@@ -272,17 +349,22 @@ type Pos01 = Line0 * int
 type Range01 = Pos01 * Pos01
 
 module Line =
+
     // Visual Studio uses line counts starting at 0, F# uses them starting at 1 
     let fromZ (line:Line0) = int line+1
+
     let toZ (line:int) : Line0 = LanguagePrimitives.Int32WithMeasure(line - 1)
 
 module Pos =
+
     let fromZ (line:Line0) idx = mkPos (Line.fromZ line) idx 
-    let toZ (p:pos) = (Line.toZ p.Line, p.Column)
 
+    let toZ (p:pos) = (Line.toZ p.Line, p.Column)
 
 module Range =
+
     let toZ (m:range) = Pos.toZ m.Start, Pos.toZ m.End
+
     let toFileZ (m:range) = m.FileName, toZ m