Commits

Bryan O'Sullivan  committed 2202ddd

Test reading of integral types

  • Participants
  • Parent commits 85def26

Comments (0)

Files changed (1)

File tests/Properties.hs

 import Text.Show.Functions ()
 
 import qualified Data.Bits as Bits (shiftL, shiftR)
-import Data.Char (chr, isLower, isSpace, isUpper, ord)
+import Numeric (showHex)
+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
 import Data.Monoid (Monoid(..))
 import Data.String (fromString)
 import Debug.Trace (trace)
 import qualified Data.Text.Lazy.Internal as TL
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Encoding as E
+import Data.Text.Read as T
+import Data.Text.Lazy.Read as TL
 import Data.Text.Encoding.Error
 import Control.Exception (SomeException, bracket, catch, evaluate, try)
 import Data.Text.Foreign
         b2 = TB.fromText (packS s2)
         b3 = TB.fromText (packS s3)
 
+-- Reading.
+
+t_decimal (n::Int) s =
+    T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
+    where t = T.dropWhile isDigit s
+tl_decimal (n::Int) s =
+    TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
+    where t = TL.dropWhile isDigit s
+t_hexadecimal (n::Positive Int) s ox =
+    T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
+    where t = T.dropWhile isHexDigit s
+          p = if ox then "0x" else ""
+tl_hexadecimal (n::Positive Int) s ox =
+    TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
+    where t = TL.dropWhile isHexDigit s
+          p = if ox then "0x" else ""
+
 -- Input and output.
 
 -- Work around lack of Show instance for TextEncoding.
     testProperty "t_builderAssociative" t_builderAssociative
   ],
 
+  testGroup "read" [
+    testProperty "t_decimal" t_decimal,
+    testProperty "tl_decimal" tl_decimal,
+    testProperty "t_hexadecimal" t_hexadecimal,
+    testProperty "tl_hexadecimal" tl_hexadecimal
+  ],
+
   testGroup "input-output" [
     testProperty "t_write_read" t_write_read,
     testProperty "tl_write_read" tl_write_read,