Commits

Bryan O'Sullivan committed bf0f811

Test reading of rational numbers, and fix a bug exposed thereby

Comments (0)

Files changed (3)

Data/Text/Lazy/Read.hs

 floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
 {-# INLINE floaty #-}
 floaty f = runP $ do
-  real <- signa (P decimal)
+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
+  real <- P decimal
   T fraction fracDigits <- perhaps (T 0 0) $ do
     _ <- char (=='.')
     digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)
     return $ T n digits
   let e c = c == 'e' || c == 'E'
   power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
-  return $! if fracDigits == 0
-            then if power == 0
-                 then fromIntegral real
-                 else fromIntegral real * (10 ^^ power)
-            else if power == 0
-                 then f real fraction (10 ^ fracDigits)
-                 else f real fraction (10 ^ fracDigits) * (10 ^^ power)
+  let n = if fracDigits == 0
+          then if power == 0
+               then fromIntegral real
+               else fromIntegral real * (10 ^^ power)
+          else if power == 0
+               then f real fraction (10 ^ fracDigits)
+               else f real fraction (10 ^ fracDigits) * (10 ^^ power)
+  return $! if sign == '+'
+            then n
+            else -n

Data/Text/Read.hs

 floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Reader a
 {-# INLINE floaty #-}
 floaty f = runP $ do
-  real <- signa (P decimal)
+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')
+  real <- P decimal
   T fraction fracDigits <- perhaps (T 0 0) $ do
     _ <- char (=='.')
     digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)
     return $ T n digits
   let e c = c == 'e' || c == 'E'
   power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)
-  return $! if fracDigits == 0
-            then if power == 0
-                 then fromIntegral real
-                 else fromIntegral real * (10 ^^ power)
-            else if power == 0
-                 then f real fraction (10 ^ fracDigits)
-                 else f real fraction (10 ^ fracDigits) * (10 ^^ power)
+  let n = if fracDigits == 0
+          then if power == 0
+               then fromIntegral real
+               else fromIntegral real * (10 ^^ power)
+          else if power == 0
+               then f real fraction (10 ^ fracDigits)
+               else f real fraction (10 ^ fracDigits) * (10 ^^ power)
+  return $! if sign == '+'
+            then n
+            else -n

tests/Properties.hs

     where t = TL.dropWhile isHexDigit s
           p = if ox then "0x" else ""
 
+isFloaty c = c `elem` "+-.0123456789eE"
+
+t_read_rational p tol (n::Double) s =
+    case p (T.pack (show n) `T.append` t) of
+      Left err      -> False
+      Right (n',t') -> t == t' && abs (n-n') <= tol
+    where t = T.dropWhile isFloaty s
+
+tl_read_rational p tol (n::Double) s =
+    case p (TL.pack (show n) `TL.append` t) of
+      Left err      -> False
+      Right (n',t') -> t == t' && abs (n-n') <= tol
+    where t = TL.dropWhile isFloaty s
+
+t_double = t_read_rational T.double 1e-13
+tl_double = tl_read_rational TL.double 1e-13
+t_rational = t_read_rational T.rational 1e-16
+tl_rational = tl_read_rational TL.rational 1e-16
+
 -- Input and output.
 
 -- Work around lack of Show instance for TextEncoding.
     testProperty "t_decimal" t_decimal,
     testProperty "tl_decimal" tl_decimal,
     testProperty "t_hexadecimal" t_hexadecimal,
-    testProperty "tl_hexadecimal" tl_hexadecimal
+    testProperty "tl_hexadecimal" tl_hexadecimal,
+    testProperty "t_double" t_double,
+    testProperty "tl_double" tl_double,
+    testProperty "t_rational" t_rational,
+    testProperty "tl_rational" tl_rational
   ],
 
   testGroup "input-output" [