[commit: base] master: Test fix for #7853 (ba5d5c4)
Max Bolingbroke
batterseapower at hotmail.com
Tue Apr 23 22:14:11 CEST 2013
Repository : ssh://darcs.haskell.org//srv/darcs/packages/base
On branch : master
https://github.com/ghc/packages-base/commit/ba5d5c479bcec7803f084cf554cae3f05abb4542
>---------------------------------------------------------------
commit ba5d5c479bcec7803f084cf554cae3f05abb4542
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date: Mon Apr 22 21:23:49 2013 +0100
Test fix for #7853
>---------------------------------------------------------------
tests/IO/T7853.hs | 28 ++++++++++++++++++++++++++++
tests/IO/T7853.stdout | 11 +++++++++++
tests/IO/all.T | 1 +
3 files changed, 40 insertions(+), 0 deletions(-)
diff --git a/tests/IO/T7853.hs b/tests/IO/T7853.hs
new file mode 100644
index 0000000..382942e
--- /dev/null
+++ b/tests/IO/T7853.hs
@@ -0,0 +1,28 @@
+import qualified Data.ByteString as BS
+import System.IO
+import GHC.Foreign
+import Control.Exception
+import Data.Word
+
+decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)
+decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc
+
+main :: IO ()
+main = mapM_ go [ ["01111111"] -- (just fits into 1 byte)
+ , ["11000010", "10000000"] -- (just large enough for 2 bytes)
+ , ["11000001", "10111111"] -- (overlong: only 7 bits, so should fit into 1 byte)
+ , ["11011111", "10111111"] -- (just fits into 2 bytes)
+ , ["11100000", "10100000", "10000000"] -- (just large enough for 3 bytes)
+ , ["11100000", "10011111", "10111111"] -- (overlong: only 11 bits, so should fit into 2 bytes)
+ , ["11101111", "10111111", "10111111"] -- (just fits into 3 bytes)
+ , ["11110000", "10010000", "10000000", "10000000"] -- (just large enough for 4 bytes)
+ , ["11110000", "10001111", "10111111", "10111111"] -- (overlong: only 16 bits, so should fit into 3 bytes)
+ , ["11110100", "10001111", "10111111", "10111111"] -- (largest allowed codepoint)
+ , ["11110111", "10111111", "10111111", "10111111"] -- (just fits into 4 bytes but disallowed by RFC3629)
+ ]
+ where go xs = decode utf8 (BS.pack (map toByte xs)) >>= either (\_ -> putStrLn "Error") print
+
+toByte :: String -> Word8
+toByte [] = 0
+toByte ('1':xs) = (2 ^ length xs) + toByte xs
+toByte ('0':xs) = toByte xs
diff --git a/tests/IO/T7853.stdout b/tests/IO/T7853.stdout
new file mode 100644
index 0000000..09b25da
--- /dev/null
+++ b/tests/IO/T7853.stdout
@@ -0,0 +1,11 @@
+"\DEL"
+"\128"
+Error
+"\2047"
+"\2048"
+Error
+"\65535"
+"\65536"
+Error
+"\1114111"
+Error
diff --git a/tests/IO/all.T b/tests/IO/all.T
index 8272ef2..7d94e13 100644
--- a/tests/IO/all.T
+++ b/tests/IO/all.T
@@ -162,3 +162,4 @@ test('encodingerror001', normal, compile_and_run, [''])
test('T4808', [exit_code(1), extra_clean(['T4808.test'])], compile_and_run, [''])
test('T4895', normal, compile_and_run, [''])
+test('T7853', normal, compile_and_run, [''])
More information about the ghc-commits
mailing list