[commit: ghc] master: Fingerprint.getFileHash: Fix not reading file at all. (41be8d3)

git at git.haskell.org git at git.haskell.org
Fri Aug 23 19:13:27 CEST 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/41be8d30356d050938f61f06c56928d2c3eb2541/ghc

>---------------------------------------------------------------

commit 41be8d30356d050938f61f06c56928d2c3eb2541
Author: Niklas Hambüchen <mail at nh2.me>
Date:   Fri Aug 23 21:46:14 2013 +0900

    Fingerprint.getFileHash: Fix not reading file at all.
    
    This lead to the stage1 compiler calculating random iface hashes.
    
    Signed-off-by: Austin Seipp <aseipp at pobox.com>


>---------------------------------------------------------------

41be8d30356d050938f61f06c56928d2c3eb2541
 compiler/utils/Fingerprint.hsc |    9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index aad964a..2f59f2a 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -20,6 +20,7 @@ module Fingerprint (
 #include "md5.h"
 ##include "HsVersions.h"
 
+import Control.Monad    ( when )
 import Numeric          ( readHex )
 #if __GLASGOW_HASKELL__ < 707
 -- Only needed for getFileHash below.
@@ -50,7 +51,10 @@ getFileHash path = withBinaryFile path ReadMode $ \h -> do
 
   fileSize <- toIntFileSize `fmap` hFileSize h
 
-  allocaBytes fileSize (\bufPtr -> fingerprintData bufPtr fileSize)
+  allocaBytes fileSize $ \bufPtr -> do
+    n <- hGetBuf h bufPtr fileSize
+    when (n /= fileSize) readFailedError
+    fingerprintData bufPtr fileSize
 
   where
     toIntFileSize :: Integer -> Int
@@ -59,4 +63,7 @@ getFileHash path = withBinaryFile path ReadMode $ \h -> do
           Sorry $ "Fingerprint.getFileHash: Tried to calculate hash of file "
                   ++ path ++ " with size > maxBound :: Int. This is not supported."
       | otherwise = fromIntegral size
+
+    readFailedError = throwGhcException $
+        Panic $ "Fingerprint.getFileHash: hGetBuf failed on interface file"
 #endif





More information about the ghc-commits mailing list