summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2020-03-17 13:55:39 +0300
committerBen Gamari <ben@well-typed.com>2020-05-24 20:42:32 -0400
commitd2581e98b75f6ac328aadbae8ca4aefd44e85c78 (patch)
treef897c9f58a5b2cbd6adb6e76ad3a2c4a50b92e92 /compiler
parentb23f16d0e01e12e18f1039b1192e45c528b9e178 (diff)
downloadhaskell-d2581e98b75f6ac328aadbae8ca4aefd44e85c78.tar.gz
FastString: fix eager reading of string ptr in hashStr
This read causes NULL dereferencing when len is 0. Fixes #17909 In the reproducer in #17909 this bug is triggered as follows: - SimplOpt.dealWithStringLiteral is called with a single-char string ("=" in #17909) - tailFS gets called on the FastString of the single-char string. - tailFS checks the length of the string, which is 1, and calls mkFastStringByteString on the tail of the ByteString, which is an empty ByteString as the original ByteString has only one char. - ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty ByteString, which is passed to mkFastStringWith. - mkFastStringWith gets hash of the NULL pointer via hashStr, which fails on empty strings because of this bug. (cherry picked from commit d15b61608a542f6349b42224140b7d227b88ef4e)
Diffstat (limited to 'compiler')
-rw-r--r--compiler/utils/FastString.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index 62a81aa10d..3a438ef23e 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -531,16 +531,22 @@ cmpStringPrefix ptr1 ptr2 len =
do r <- memcmp ptr1 ptr2 len
return (r == 0)
-
hashStr :: Ptr Word8 -> Int -> Int
-- use the Addr to produce a hash value between 0 & m (inclusive)
hashStr (Ptr a#) (I# len#) = loop 0# 0#
- where
- loop h n | isTrue# (n ==# len#) = I# h
- | otherwise = loop h2 (n +# 1#)
- where
- !c = ord# (indexCharOffAddr# a# n)
- !h2 = (h *# 16777619#) `xorI#` c
+ where
+ loop h n =
+ if isTrue# (n ==# len#) then
+ I# h
+ else
+ let
+ -- DO NOT move this let binding! indexCharOffAddr# reads from the
+ -- pointer so we need to evaluate this based on the length check
+ -- above. Not doing this right caused #17909.
+ !c = ord# (indexCharOffAddr# a# n)
+ !h2 = (h *# 16777619#) `xorI#` c
+ in
+ loop h2 (n +# 1#)
-- -----------------------------------------------------------------------------
-- Operations