diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 11 | ||||
| -rw-r--r-- | compiler/utils/Pretty.lhs | 15 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout | 3 |
3 files changed, 18 insertions, 11 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 35e9c7e226..36f453f63b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1485,13 +1485,16 @@ defaultLogAction dflags severity srcSpan style msg putStrSDoc = defaultLogActionHPutStrDoc dflags stdout defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () -defaultLogActionHPrintDoc = defaultLogActionHPutStrDoc +defaultLogActionHPrintDoc dflags h d sty + = defaultLogActionHPutStrDoc dflags h (d $$ text "") sty + -- Adds a newline defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () defaultLogActionHPutStrDoc dflags h d sty - = Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc - where - doc = runSDoc d (initSDocContext dflags sty) + = Pretty.printDoc_ Pretty.PageMode (pprCols dflags) h doc + where -- Don't add a newline at the end, so that successive + -- calls to this log-action can output all on the same line + doc = runSDoc d (initSDocContext dflags sty) newtype FlushOut = FlushOut (IO ()) diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs index 0bac66e04e..fb7fe2b7fb 100644 --- a/compiler/utils/Pretty.lhs +++ b/compiler/utils/Pretty.lhs @@ -173,7 +173,7 @@ module Pretty ( hang, punctuate, - fullRender, printDoc, showDoc, + fullRender, printDoc, printDoc_, showDoc, bufLeftRender -- performance hack ) where @@ -985,9 +985,16 @@ spaces n | n <=# _ILIT(0) = "" \begin{code} printDoc :: Mode -> Int -> Handle -> Doc -> IO () -printDoc LeftMode _ hdl doc +-- printDoc adds a newline to the end +printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text "") + +printDoc_ :: Mode -> Int -> Handle -> Doc -> IO () +-- printDoc_ does not add a newline at the end, so that +-- successive calls can output stuff on the same line +-- Rather like putStr vs putStrLn +printDoc_ LeftMode _ hdl doc = do { printLeftRender hdl doc; hFlush hdl } -printDoc mode pprCols hdl doc +printDoc_ mode pprCols hdl doc = do { fullRender mode pprCols 1.5 put done doc ; hFlush hdl } where @@ -999,7 +1006,7 @@ printDoc mode pprCols hdl doc put (ZStr s) next = hPutFZS hdl s >> next put (LStr s l) next = hPutLitString hdl s l >> next - done = hPutChar hdl '\n' + done = return () -- hPutChar hdl '\n' -- some versions of hPutBuf will barf if the length is zero hPutLitString :: Handle -> Ptr a -> Int# -> IO () diff --git a/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout b/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout index f774e1e642..65ab5e6126 100644 --- a/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/dynbrk009.stdout @@ -3,9 +3,6 @@ _result :: Int = _ Stopped at dynbrk009.hs:8:27-36 _result :: Int = _ Stopped at dynbrk009.hs:8:31-35 - Stopped at dynbrk009.hs:6:1-9 - Stopped at dynbrk009.hs:6:9 - 3 |