on master help sign in
Test reading of rational numbers, and fix a bug exposed thereby

--HG-- extra : convert_revision : 391dfeb26cbd98643c57b743a8689ff0f97e9ad4

commit6ef71c299c60bfd6f4525e1ce69959dc04759014 authorBryan O'Sullivan <bos@serpentine.com> dateMon 18 Oct 2010, 03:12 (16 years ago) parentf5347a7
3 files changed+48−17
Data/Text/Lazy/Read.hs+12−8 Data/Text/Read.hs+12−8 tests/Properties.hs+24−1
Data/Text/Lazy/Read.hs+12−8
@@ -138,7 +138,8 @@ data T = T !Integer !Int
138138floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
139139{-# INLINE floaty #-}
140140floaty f = runP $ do
141− real <- signa (P decimal)
141+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
142+ real <- P decimal
142143 T fraction fracDigits <- perhaps (T 0 0) $ do
143144 _ <- char (=='.')
144145 digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)
@@ -146,10 +147,13 @@ floaty f = runP $ do
146147 return $ T n digits
147148 let e c = c == 'e' || c == 'E'
148149 power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
149− return $! if fracDigits == 0
150− then if power == 0
151− then fromIntegral real
152− else fromIntegral real * (10 ^^ power)
153− else if power == 0
154− then f real fraction (10 ^ fracDigits)
155− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
150+ let n = if fracDigits == 0
151+ then if power == 0
152+ then fromIntegral real
153+ else fromIntegral real * (10 ^^ power)
154+ else if power == 0
155+ then f real fraction (10 ^ fracDigits)
156+ else f real fraction (10 ^ fracDigits) * (10 ^^ power)
157+ return $! if sign == '+'
158+ then n
159+ else -n
Data/Text/Read.hs+12−8
@@ -138,7 +138,8 @@ data T = T !Integer !Int
138138floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
139139{-# INLINE floaty #-}
140140floaty f = runP $ do
141− real <- signa (P decimal)
141+ sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
142+ real <- P decimal
142143 T fraction fracDigits <- perhaps (T 0 0) $ do
143144 _ <- char (=='.')
144145 digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
@@ -146,10 +147,13 @@ floaty f = runP $ do
146147 return $ T n digits
147148 let e c = c == 'e' || c == 'E'
148149 power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
149− return $! if fracDigits == 0
150− then if power == 0
151− then fromIntegral real
152− else fromIntegral real * (10 ^^ power)
153− else if power == 0
154− then f real fraction (10 ^ fracDigits)
155− else f real fraction (10 ^ fracDigits) * (10 ^^ power)
150+ let n = if fracDigits == 0
151+ then if power == 0
152+ then fromIntegral real
153+ else fromIntegral real * (10 ^^ power)
154+ else if power == 0
155+ then f real fraction (10 ^ fracDigits)
156+ else f real fraction (10 ^ fracDigits) * (10 ^^ power)
157+ return $! if sign == '+'
158+ then n
159+ else -n
tests/Properties.hs+24−1
@@ -678,6 +678,25 @@ tl_hexadecimal (n::Positive Int) s ox =
678678 where t = TL.dropWhile isHexDigit s
679679 p = if ox then "0x" else ""
680680
681+isFloaty c = c `elem` "+-.0123456789eE"
682+
683+t_read_rational p tol (n::Double) s =
684+ case p (T.pack (show n) `T.append` t) of
685+ Left err -> False
686+ Right (n',t') -> t == t' && abs (n-n') <= tol
687+ where t = T.dropWhile isFloaty s
688+
689+tl_read_rational p tol (n::Double) s =
690+ case p (TL.pack (show n) `TL.append` t) of
691+ Left err -> False
692+ Right (n',t') -> t == t' && abs (n-n') <= tol
693+ where t = TL.dropWhile isFloaty s
694+
695+t_double = t_read_rational T.double 1e-13
696+tl_double = tl_read_rational TL.double 1e-13
697+t_rational = t_read_rational T.rational 1e-16
698+tl_rational = tl_read_rational TL.rational 1e-16
699+
681700-- Input and output.
682701
683702-- Work around lack of Show instance for TextEncoding.
@@ -1163,7 +1182,11 @@ tests = [
11631182 testProperty "t_decimal" t_decimal,
11641183 testProperty "tl_decimal" tl_decimal,
11651184 testProperty "t_hexadecimal" t_hexadecimal,
1166− testProperty "tl_hexadecimal" tl_hexadecimal
1185+ testProperty "tl_hexadecimal" tl_hexadecimal,
1186+ testProperty "t_double" t_double,
1187+ testProperty "tl_double" tl_double,
1188+ testProperty "t_rational" t_rational,
1189+ testProperty "tl_rational" tl_rational
11671190 ],
11681191
11691192 testGroup "input-output" [