From: Ian Lynagh Date: Tue, 13 Apr 2010 13:43:39 +0000 (+0000) Subject: Fix bitrot in IO debugging code X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=18d76310cb679667c9d3e491277c283a0dccee06;p=ghc-base.git Fix bitrot in IO debugging code Also switched to using Haskell Bools (rather than CPP) to en/disable it, so it shouldn't break again in the future. --- diff --git a/GHC/IO/Encoding/Iconv.hs b/GHC/IO/Encoding/Iconv.hs index 8ef87c9..4de9cfe 100644 --- a/GHC/IO/Encoding/Iconv.hs +++ b/GHC/IO/Encoding/Iconv.hs @@ -30,8 +30,6 @@ module GHC.IO.Encoding.Iconv ( #if !defined(mingw32_HOST_OS) -#undef DEBUG_DUMP - import Foreign import Foreign.C import Data.Maybe @@ -41,27 +39,21 @@ import GHC.IO.Encoding.Types import GHC.Num import GHC.Show import GHC.Real -#ifdef DEBUG_DUMP import System.Posix.Internals -#endif -iconv_trace :: String -> IO () +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False -#ifdef DEBUG_DUMP - -iconv_trace s = puts s +iconv_trace :: String -> IO () +iconv_trace s + | c_DEBUG_DUMP = puts s + | otherwise = return () puts :: String -> IO () -puts s = do withCStringLen (s++"\n") $ \(p, len) -> - c_write 1 (castPtr p) (fromIntegral len) +puts s = do _ <- withCStringLen (s ++ "\n") $ \(p, len) -> + c_write 1 (castPtr p) (fromIntegral len) return () -#else - -iconv_trace _ = return () - -#endif - -- ----------------------------------------------------------------------------- -- iconv encoders/decoders diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs index 98eeeab..4425a3a 100644 --- a/GHC/IO/FD.hs +++ b/GHC/IO/FD.hs @@ -22,17 +22,13 @@ module GHC.IO.FD ( stdin, stdout, stderr ) where -#undef DEBUG_DUMP - import GHC.Base import GHC.Num import GHC.Real import GHC.Show import GHC.Enum import Data.Maybe -#ifndef mingw32_HOST_OS import Control.Monad -#endif import Data.Typeable import GHC.IO @@ -51,6 +47,9 @@ import System.Posix.Internals hiding (FD, setEcho, getEcho) import System.Posix.Types -- import GHC.Ptr +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + -- ----------------------------------------------------------------------------- -- The file-descriptor IO device @@ -108,20 +107,17 @@ instance BufferedIO FD where readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8) readBuf' fd buf = do -#ifdef DEBUG_DUMP - puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n") -#endif + when c_DEBUG_DUMP $ + puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n") (r,buf') <- readBuf fd buf -#ifdef DEBUG_DUMP - puts ("after: " ++ summaryBuffer buf' ++ "\n") -#endif + when c_DEBUG_DUMP $ + puts ("after: " ++ summaryBuffer buf' ++ "\n") return (r,buf') writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8) writeBuf' fd buf = do -#ifdef DEBUG_DUMP - puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n") -#endif + when c_DEBUG_DUMP $ + puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n") writeBuf fd buf -- ----------------------------------------------------------------------------- @@ -626,8 +622,7 @@ foreign import ccall unsafe "unlockFile" unlockFile :: CInt -> IO CInt #endif -#if defined(DEBUG_DUMP) puts :: String -> IO () -puts s = do withCStringLen s $ \(p,len) -> c_write 1 p (fromIntegral len) +puts s = do _ <- withCStringLen s $ \(p,len) -> + c_write 1 (castPtr p) (fromIntegral len) return () -#endif diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs index cc9e3d3..afac030 100644 --- a/GHC/IO/Handle/Internals.hs +++ b/GHC/IO/Handle/Internals.hs @@ -4,8 +4,6 @@ {-# OPTIONS_GHC -XRecordWildCards #-} {-# OPTIONS_HADDOCK hide #-} -#undef DEBUG_DUMP - ----------------------------------------------------------------------------- -- | -- Module : GHC.IO.Handle.Internals @@ -74,9 +72,10 @@ import Foreign -- import System.IO.Error import System.Posix.Internals hiding (FD) -#ifdef DEBUG_DUMP import Foreign.C -#endif + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False -- --------------------------------------------------------------------------- -- Creating a new handle @@ -673,13 +672,12 @@ hLookAhead_ handle_@Handle__{..} = do -- debugging debugIO :: String -> IO () -#if defined(DEBUG_DUMP) -debugIO s = do - withCStringLen (s++"\n") $ \(p,len) -> c_write 1 (castPtr p) (fromIntegral len) - return () -#else -debugIO s = return () -#endif +debugIO s + | c_DEBUG_DUMP + = do _ <- withCStringLen (s ++ "\n") $ + \(p, len) -> c_write 1 (castPtr p) (fromIntegral len) + return () + | otherwise = return () -- ---------------------------------------------------------------------------- -- Text input/output