Correct off by one error in ghci +c

Fixes #16569

7 files changed, 25 insertions, 8 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 21ef7969ba..383b7fe302 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2146,7 +2146,9 @@ parseSpanArg s = do
 
     let fs    = mkFastString fp
         span' = mkRealSrcSpan (mkRealSrcLoc fs sl sc)
-                              (mkRealSrcLoc fs el ec)
+                              -- End column of RealSrcSpan is the column
+                              -- after the end of the span.
+                              (mkRealSrcLoc fs el (ec + 1))
 
     return (span',trailer)
   where
@@ -2192,7 +2194,9 @@ showRealSrcSpan spn = concat [ fp, ":(", show sl, ",", show sc
     sl = srcSpanStartLine spn
     sc = srcSpanStartCol  spn
     el = srcSpanEndLine   spn
-    ec = srcSpanEndCol    spn
+    -- The end column is the column after the end of the span see the
+    -- RealSrcSpan module
+    ec = let ec' = srcSpanEndCol    spn in if ec' == 0 then 0 else ec' - 1
 
 -----------------------------------------------------------------------------
 -- | @:kind@ command
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index d42f019e5f..2bf061f3b5 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -75,6 +75,9 @@ data SpanInfo = SpanInfo
       -- locality, definition location, etc.
     }
 
+instance Outputable SpanInfo where
+  ppr (SpanInfo s t i) = ppr s <+> ppr t <+> ppr i
+
 -- | Test whether second span is contained in (or equal to) first span.
 -- This is basically 'containsSpan' for 'SpanInfo'
 containsSpanInfo :: SpanInfo -> SpanInfo -> Bool
diff --git a/testsuite/tests/ghci/scripts/T16569.hs b/testsuite/tests/ghci/scripts/T16569.hs
new file mode 100644
index 0000000000..af7c49f71e
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16569.hs
@@ -0,0 +1,4 @@
+module T16569 where
+
+main :: IO ()
+main = putStrLn (case (undefined :: Int) of _ -> undefined)
diff --git a/testsuite/tests/ghci/scripts/T16569.script b/testsuite/tests/ghci/scripts/T16569.script
new file mode 100644
index 0000000000..cc8b2e6f58
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16569.script
@@ -0,0 +1,3 @@
+:set +c
+:l T16569.hs
+::type-at T16569.hs 4 8 4 59
diff --git a/testsuite/tests/ghci/scripts/T16569.stdout b/testsuite/tests/ghci/scripts/T16569.stdout
new file mode 100644
index 0000000000..957a0ff6b3
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16569.stdout
@@ -0,0 +1,2 @@
+Collecting type info for 1 module(s) ... 
+ :: IO ()
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index eb0a3a5d8e..c2d9d9fc6e 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -295,3 +295,4 @@ test('T16089', normal, ghci_script, ['T16089.script'])
 test('T14828', normal, ghci_script, ['T14828.script'])
 test('T16376', normal, ghci_script, ['T16376.script'])
 test('T16527', normal, ghci_script, ['T16527.script'])
+test('T16569', normal, ghci_script, ['T16569.script'])
diff --git a/testsuite/tests/ghci/should_run/T15369.stdout b/testsuite/tests/ghci/should_run/T15369.stdout
index 0bb004c24a..fbea6150c3 100644
--- a/testsuite/tests/ghci/should_run/T15369.stdout
+++ b/testsuite/tests/ghci/should_run/T15369.stdout
@@ -1,8 +1,8 @@
 Collecting type info for 1 module(s) ... 
-T15369.hs:(3,1)-(3,2): GHC.Types.Int
-T15369.hs:(3,5)-(3,6): GHC.Types.Int
-T15369.hs:(3,1)-(3,2): GHC.Types.Int
-T15369.hs:(3,5)-(3,6): GHC.Types.Int
+T15369.hs:(3,1)-(3,1): GHC.Types.Int
+T15369.hs:(3,5)-(3,5): GHC.Types.Int
+T15369.hs:(3,1)-(3,1): GHC.Types.Int
+T15369.hs:(3,5)-(3,5): GHC.Types.Int
 Collecting type info for 1 module(s) ... 
-T15369.hs:(3,1)-(3,2): GHC.Types.Double
-T15369.hs:(3,5)-(3,6): GHC.Types.Double
+T15369.hs:(3,1)-(3,1): GHC.Types.Double
+T15369.hs:(3,5)-(3,5): GHC.Types.Double