text 2.0.2 → 2.1
raw patch · 19 files changed
+448/−53 lines, 19 filesdep +data-array-bytedep ~QuickCheckdep ~ghc-primdep ~template-haskellnew-uploader
Dependencies added: data-array-byte
Dependency ranges changed: QuickCheck, ghc-prim, template-haskell
Files
- cbits/validate_utf8.cpp +5/−0
- changelog.md +14/−0
- scripts/CaseFoldExceptions.hs +17/−0
- src/Data/Text.hs +4/−2
- src/Data/Text/Array.hs +16/−6
- src/Data/Text/IO.hs +4/−1
- src/Data/Text/IO/Utf8.hs +93/−0
- src/Data/Text/Internal/Encoding.hs +2/−1
- src/Data/Text/Internal/Encoding/Fusion.hs +3/−2
- src/Data/Text/Internal/Lazy/Encoding/Fusion.hs +13/−12
- src/Data/Text/Internal/PrimCompat.hs +3/−5
- src/Data/Text/Internal/Validate.hs +149/−0
- src/Data/Text/Internal/Validate/Simd.hs +42/−0
- tests/Tests.hs +2/−0
- tests/Tests/Properties/LowLevel.hs +7/−1
- tests/Tests/QuickCheckUtils.hs +4/−1
- tests/Tests/RebindableSyntaxTest.hs +14/−0
- tests/Tests/Regressions.hs +35/−1
- text.cabal +21/−21
cbits/validate_utf8.cpp view
@@ -4,3 +4,8 @@ int _hs_text_is_valid_utf8(const char* str, size_t len){ return simdutf::validate_utf8(str, len); }++extern "C"+int _hs_text_is_valid_utf8_offset(const char* str, size_t off, size_t len){+ return simdutf::validate_utf8(str + off, len);+}
changelog.md view
@@ -1,3 +1,17 @@+### 2.1++* [Switch `Data.Text.Array` to `Data.Array.Byte`](https://github.com/haskell/text/pull/474)++* [Add `Text.IO.Utf8` module](https://github.com/haskell/text/pull/503)++* [Expose UTF-8 validation functions from internal module](https://github.com/haskell/text/pull/483)++* [Fix handling of incomplete input in stream decoders](https://github.com/haskell/text/pull/527)++* [Fix handling of invalid bytes in stream decoders](https://github.com/haskell/text/pull/528)++* [Make Lift Text work under RebindableSyntax](https://github.com/haskell/text/pull/534)+ ### 2.0.2 * [Add decoding functions in `Data.Text.Encoding` that allow
+ scripts/CaseFoldExceptions.hs view
@@ -0,0 +1,17 @@+-- Generates exceptions for tests/Tests/Properties/Text.hs+-- runghc CaseFoldExceptions.txt++import qualified Data.Char+import Data.List+import qualified Data.Text as T++toCaseFoldExceptions :: String+toCaseFoldExceptions = filter (\c -> c `notElem` (cherokeeUpper ++ cherokeeLower)) $+ filter (\c -> T.toCaseFold (T.singleton c) /= T.singleton (Data.Char.toLower c))+ [minBound .. maxBound]++cherokeeUpper = ['\x13A0'..'\x13F7'] -- x13F8..13FF are lowercase+cherokeeLower = ['\xAB70'..'\xABBF']++main :: IO ()+main = print toCaseFoldExceptions
src/Data/Text.hs view
@@ -418,8 +418,10 @@ #if MIN_VERSION_template_haskell(2,16,0) lift txt = do let (ptr, len) = unsafePerformIO $ asForeignPtr txt- let lenInt = P.fromIntegral len- TH.appE (TH.appE (TH.varE 'unpackCStringLen#) (TH.litE . TH.bytesPrimL $ TH.mkBytes ptr 0 lenInt)) (TH.lift lenInt)+ bytesQ = TH.litE . TH.bytesPrimL $ TH.mkBytes ptr 0 (P.fromIntegral len)+ lenQ = liftInt (P.fromIntegral len)+ liftInt n = (TH.appE (TH.conE 'Exts.I#) (TH.litE (TH.IntPrimL n)))+ TH.varE 'unpackCStringLen# `TH.appE` bytesQ `TH.appE` lenQ #else lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack #endif
src/Data/Text/Array.hs view
@@ -1,5 +1,12 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes,- RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+ {-# OPTIONS_GHC -fno-warn-unused-matches #-} -- | -- Module : Data.Text.Array@@ -24,8 +31,10 @@ module Data.Text.Array ( -- * Types- Array(..)- , MArray(..)+ Array+ , pattern ByteArray+ , MArray+ , pattern MutableByteArray -- * Functions , resizeM , shrinkM@@ -60,12 +69,13 @@ import GHC.Word (Word8(..)) import qualified Prelude import Prelude hiding (length, read, compare)+import Data.Array.Byte (ByteArray(..), MutableByteArray(..)) -- | Immutable array type.-data Array = ByteArray ByteArray#+type Array = ByteArray -- | Mutable array type, for use in the ST monad.-data MArray s = MutableByteArray (MutableByteArray# s)+type MArray = MutableByteArray -- | Create an uninitialized mutable array. new :: forall s. Int -> ST s (MArray s)
src/Data/Text/IO.hs view
@@ -13,8 +13,11 @@ -- The functions in this module obey the runtime system's locale, -- character set encoding, and line ending conversion settings. --+-- If you want to do I\/O using the UTF-8 encoding, use @Data.Text.IO.Utf8@,+-- which is faster than this module.+-- -- If you know in advance that you will be working with data that has--- a specific encoding (e.g. UTF-8), and your application is highly+-- a specific encoding, and your application is highly -- performance sensitive, you may find that it is faster to perform -- I\/O with bytestrings and to encode and decode yourself than to use -- the functions in this module.
+ src/Data/Text/IO/Utf8.hs view
@@ -0,0 +1,93 @@+-- |+-- Module : Data.Text.IO.Utf8+-- License : BSD-style+-- Portability : GHC+--+-- Efficient UTF-8 support for text I\/O.+-- Unlike @Data.Text.IO@, these functions do not depend on the locale+-- and do not do line ending conversion.+module Data.Text.IO.Utf8+ (+ -- * File-at-a-time operations+ readFile+ , writeFile+ , appendFile+ -- * Operations on handles+ , hGetContents+ , hGetLine+ , hPutStr+ , hPutStrLn+ -- * Special cases for standard input and output+ , interact+ , getContents+ , getLine+ , putStr+ , putStrLn+ ) where++import Prelude hiding (readFile, writeFile, appendFile, interact, getContents, getLine, putStr, putStrLn)+import Control.Exception (evaluate)+import Control.Monad ((<=<))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import GHC.IO.Handle (Handle)+import qualified Data.ByteString.Char8 as B.Char8++decodeUtf8IO :: ByteString -> IO Text+decodeUtf8IO = evaluate . decodeUtf8++-- | The 'readFile' function reads a file and returns the contents of+-- the file as a string. The entire file is read strictly, as with+-- 'getContents'.+readFile :: FilePath -> IO Text+readFile = decodeUtf8IO <=< B.readFile++-- | Write a string to a file. The file is truncated to zero length+-- before writing begins.+writeFile :: FilePath -> Text -> IO ()+writeFile fp = B.writeFile fp . encodeUtf8++-- | Write a string to the end of a file.+appendFile :: FilePath -> Text -> IO ()+appendFile fp = B.appendFile fp . encodeUtf8++-- | Read the remaining contents of a 'Handle' as a string.+hGetContents :: Handle -> IO Text+hGetContents = decodeUtf8IO <=< B.hGetContents++-- | Read a single line from a handle.+hGetLine :: Handle -> IO Text+hGetLine = decodeUtf8IO <=< B.hGetLine++-- | Write a string to a handle.+hPutStr :: Handle -> Text -> IO ()+hPutStr h = B.hPutStr h . encodeUtf8++-- | Write a string to a handle, followed by a newline.+hPutStrLn :: Handle -> Text -> IO ()+hPutStrLn h t = hPutStr h t >> B.hPutStr h (B.Char8.singleton '\n')++-- | The 'interact' function takes a function of type @Text -> Text@+-- as its argument. The entire input from the standard input device is+-- passed to this function as its argument, and the resulting string+-- is output on the standard output device.+interact :: (Text -> Text) -> IO ()+interact f = putStr . f =<< getContents++-- | Read all user input on 'stdin' as a single string.+getContents :: IO Text+getContents = decodeUtf8IO =<< B.getContents++-- | Read a single line of user input from 'stdin'.+getLine :: IO Text+getLine = decodeUtf8IO =<< B.getLine++-- | Write a string to 'stdout'.+putStr :: Text -> IO ()+putStr = B.putStr . encodeUtf8++-- | Write a string to 'stdout', followed by a newline.+putStrLn :: Text -> IO ()+putStrLn t = B.putStr (encodeUtf8 t) >> B.putStr (B.Char8.singleton '\n')
src/Data/Text/Internal/Encoding.hs view
@@ -244,7 +244,8 @@ {-# INLINE validateUtf8ChunkFrom #-} validateUtf8ChunkFrom :: forall r. Int -> ByteString -> (Int -> Maybe Utf8State -> r) -> r validateUtf8ChunkFrom ofs bs k-#if defined(SIMDUTF) || MIN_VERSION_bytestring(0,11,2)+ -- B.isValidUtf8 is buggy before bytestring-0.11.5.0+#if defined(SIMDUTF) || MIN_VERSION_bytestring(0,11,5) | guessUtf8Boundary > 0 && -- the rest of the bytestring is valid utf-8 up to the boundary (
src/Data/Text/Internal/Encoding/Fusion.hs view
@@ -38,7 +38,7 @@ import Control.Exception (assert) #endif import Data.Bits (shiftL, shiftR)-import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)+import Data.ByteString.Internal (ByteString(..), mallocByteString) import Data.Text.Internal.Fusion (Step(..), Stream(..)) import Data.Text.Internal.Fusion.Size import Data.Text.Encoding.Error@@ -47,6 +47,7 @@ import Data.Text.Internal.Unsafe (unsafeWithForeignPtr) import Data.Word (Word8, Word16, Word32) import Foreign.ForeignPtr (ForeignPtr)+import Foreign.Marshal.Utils (copyBytes) import Foreign.Storable (pokeByteOff) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B@@ -197,7 +198,7 @@ dest <- mallocByteString destLen unsafeWithForeignPtr src $ \src' -> unsafeWithForeignPtr dest $ \dest' ->- memcpy dest' src' srcLen+ copyBytes dest' src' srcLen return dest decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
src/Data/Text/Internal/Lazy/Encoding/Fusion.hs view
@@ -49,8 +49,9 @@ import qualified Data.Text.Internal.Encoding.Utf32 as U32 import Data.Text.Unsafe (unsafeDupablePerformIO) import Foreign.ForeignPtr (ForeignPtr)+import Foreign.Marshal.Utils (copyBytes) import Foreign.Storable (pokeByteOff)-import Data.ByteString.Internal (mallocByteString, memcpy)+import Data.ByteString.Internal (mallocByteString) #if defined(ASSERTS) import Control.Exception (assert) #endif@@ -99,10 +100,10 @@ S2 a b -> next (T bs (S3 a b x) (i+1)) S3 a b c -> next (T bs (S4 a b c x) (i+1)) S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)- (T bs (S3 b c d) (i+1))+ (T bs (S4 b c d x) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st+ consume (T Empty _ i) = decodeError "streamUtf8" "UTF-8" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf8 #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little@@ -139,10 +140,10 @@ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1)) S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1)) S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))+ (T bs (S4 w2 w3 w4 x) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st+ consume (T Empty _ i) = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf16LE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big@@ -179,10 +180,10 @@ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1)) S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1)) S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))+ (T bs (S4 w2 w3 w4 x) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st+ consume (T Empty _ i) = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf16BE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big@@ -223,10 +224,10 @@ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1)) S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1)) S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))+ (T bs (S4 w2 w3 w4 x) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st+ consume (T Empty _ i) = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf32BE #-} -- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little@@ -267,10 +268,10 @@ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1)) S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1)) S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)- (T bs (S3 w2 w3 w4) (i+1))+ (T bs (S4 w2 w3 w4 x) (i+1)) where x = B.unsafeIndex ps i consume (T Empty S0 _) = Done- consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st+ consume (T Empty _ i) = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (T Empty S0 i) {-# INLINE [0] streamUtf32LE #-} -- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.@@ -308,7 +309,7 @@ dest <- mallocByteString destLen unsafeWithForeignPtr src $ \src' -> unsafeWithForeignPtr dest $ \dest' ->- memcpy dest' src' srcLen+ copyBytes dest' src' srcLen return dest -- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
src/Data/Text/Internal/PrimCompat.hs view
@@ -13,13 +13,12 @@ ) where #if MIN_VERSION_base(4,16,0)--import GHC.Base-+import GHC.Exts (wordToWord8#,word8ToWord#,wordToWord16#,word16ToWord#,wordToWord32#,word32ToWord#) #else- import GHC.Prim (Word#)+#endif +#if !(MIN_VERSION_base(4,16,0)) wordToWord8#, word8ToWord# :: Word# -> Word# wordToWord16#, word16ToWord# :: Word# -> Word# wordToWord32#, word32ToWord# :: Word# -> Word#@@ -33,5 +32,4 @@ {-# INLINE word16ToWord# #-} {-# INLINE wordToWord32# #-} {-# INLINE word32ToWord# #-}- #endif
+ src/Data/Text/Internal/Validate.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}++-- | Test whether or not a sequence of bytes is a valid UTF-8 byte sequence.+-- In the GHC Haskell ecosystem, there are several representations of byte+-- sequences. The only one that the stable @text@ API concerns itself with is+-- 'ByteString'. Part of bytestring-to-text decoding is 'isValidUtf8ByteString',+-- a high-performance UTF-8 validation routine written in C++ with fallbacks+-- for various platforms. The C++ code backing this routine is nontrivial,+-- so in the interest of reuse, this module additionally exports functions+-- for working with the GC-managed @ByteArray@ type. These @ByteArray@+-- functions are not used anywhere else in @text@. They are for the benefit+-- of library and application authors who do not use 'ByteString' but still+-- need to interoperate with @text@.+module Data.Text.Internal.Validate+ (+ -- * ByteString+ isValidUtf8ByteString+ -- * ByteArray+ --+ -- | Is the slice of a byte array a valid UTF-8 byte sequence? These+ -- functions all accept an offset and a length.+ , isValidUtf8ByteArray+ , isValidUtf8ByteArrayUnpinned+ , isValidUtf8ByteArrayPinned+ ) where++import Data.Array.Byte (ByteArray(ByteArray))+import Data.ByteString (ByteString)+import GHC.Exts (isTrue#,isByteArrayPinned#)++#ifdef SIMDUTF+import Data.Text.Unsafe (unsafeDupablePerformIO)+import Data.Text.Internal.ByteStringCompat (withBS)+import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)+import Data.Text.Internal.Validate.Simd (c_is_valid_utf8_bytearray_safe,c_is_valid_utf8_bytearray_unsafe,c_is_valid_utf8_ptr_unsafe)+#else+import GHC.Exts (ByteArray#)+import Data.Text.Internal.Encoding.Utf8 (CodePoint(..),DecoderResult(..),utf8DecodeStart,utf8DecodeContinue)+import GHC.Exts (Int(I#),indexWord8Array#)+import GHC.Word (Word8(W8#))+import qualified Data.ByteString as B+#if !MIN_VERSION_bytestring(0,11,2)+import qualified Data.ByteString.Unsafe as B+#endif+#endif++-- | Is the ByteString a valid UTF-8 byte sequence?+isValidUtf8ByteString :: ByteString -> Bool+#ifdef SIMDUTF+isValidUtf8ByteString bs = withBS bs $ \fp len -> unsafeDupablePerformIO $+ unsafeWithForeignPtr fp $ \ptr -> (/= 0) <$> c_is_valid_utf8_ptr_unsafe ptr (fromIntegral len)+#else+#if MIN_VERSION_bytestring(0,11,2)+isValidUtf8ByteString = B.isValidUtf8+#else+isValidUtf8ByteString bs = start 0+ where+ start ix+ | ix >= B.length bs = True+ | otherwise = case utf8DecodeStart (B.unsafeIndex bs ix) of+ Accept{} -> start (ix + 1)+ Reject{} -> False+ Incomplete st _ -> step (ix + 1) st+ step ix st+ | ix >= B.length bs = False+ -- We do not use decoded code point, so passing a dummy value to save an argument.+ | otherwise = case utf8DecodeContinue (B.unsafeIndex bs ix) st (CodePoint 0) of+ Accept{} -> start (ix + 1)+ Reject{} -> False+ Incomplete st' _ -> step (ix + 1) st'+#endif+#endif++-- | For pinned byte arrays larger than 128KiB, this switches to the safe FFI+-- so that it does not prevent GC. This threshold (128KiB) was chosen+-- somewhat arbitrarily and may change in the future.+isValidUtf8ByteArray ::+ ByteArray -- ^ Bytes+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> Bool+isValidUtf8ByteArray b@(ByteArray b#) !off !len+ | len >= 131072 -- 128KiB+ , isTrue# (isByteArrayPinned# b#)+ = isValidUtf8ByteArrayPinned b off len+ | otherwise = isValidUtf8ByteArrayUnpinned b off len++-- | This uses the @unsafe@ FFI. GC waits for all @unsafe@ FFI calls+-- to complete before starting. Consequently, an @unsafe@ FFI call does not+-- run concurrently with GC and is not interrupted by GC. Since relocation+-- cannot happen concurrently with an @unsafe@ FFI call, it is safe+-- to call this function with an unpinned byte array argument.+-- It is also safe to call this with a pinned @ByteArray@ argument.+isValidUtf8ByteArrayUnpinned ::+ ByteArray -- ^ Bytes+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> Bool+#ifdef SIMDUTF+isValidUtf8ByteArrayUnpinned (ByteArray bs) !off !len =+ unsafeDupablePerformIO $ (/= 0) <$> c_is_valid_utf8_bytearray_unsafe bs (fromIntegral off) (fromIntegral len)+#else+isValidUtf8ByteArrayUnpinned (ByteArray bs) = isValidUtf8ByteArrayHaskell# bs+#endif++-- | This uses the @safe@ FFI. GC may run concurrently with @safe@+-- FFI calls. Consequently, unpinned objects may be relocated while a+-- @safe@ FFI call is executing. The byte array argument /must/ be pinned,+-- and the calling context is responsible for enforcing this. If the+-- byte array is not pinned, this function's behavior is undefined.+isValidUtf8ByteArrayPinned ::+ ByteArray -- ^ Bytes+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> Bool+#ifdef SIMDUTF+isValidUtf8ByteArrayPinned (ByteArray bs) !off !len =+ unsafeDupablePerformIO $ (/= 0) <$> c_is_valid_utf8_bytearray_safe bs (fromIntegral off) (fromIntegral len)+#else+isValidUtf8ByteArrayPinned (ByteArray bs) = isValidUtf8ByteArrayHaskell# bs+#endif++#ifndef SIMDUTF+isValidUtf8ByteArrayHaskell# ::+ ByteArray# -- ^ Bytes+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> Bool+isValidUtf8ByteArrayHaskell# b !off !len = start off+ where+ indexWord8 :: ByteArray# -> Int -> Word8+ indexWord8 !x (I# i) = W8# (indexWord8Array# x i)+ start ix+ | ix >= len = True+ | otherwise = case utf8DecodeStart (indexWord8 b ix) of+ Accept{} -> start (ix + 1)+ Reject{} -> False+ Incomplete st _ -> step (ix + 1) st+ step ix st+ | ix >= len = False+ -- We do not use decoded code point, so passing a dummy value to save an argument.+ | otherwise = case utf8DecodeContinue (indexWord8 b ix) st (CodePoint 0) of+ Accept{} -> start (ix + 1)+ Reject{} -> False+ Incomplete st' _ -> step (ix + 1) st'+#endif
+ src/Data/Text/Internal/Validate/Simd.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}++-- | Validate that a byte sequence is UTF-8-encoded text. All of these+-- functions return zero when the byte sequence is not UTF-8-encoded text,+-- and they return an unspecified non-zero value when the byte sequence+-- is UTF-8-encoded text.+--+-- Variants are provided for both @ByteArray#@ and @Ptr@. Additionally,+-- variants are provided that use both the @safe@ and @unsafe@ FFI.+--+-- If compiling with SIMDUTF turned off, this module exports nothing.+module Data.Text.Internal.Validate.Simd+ ( c_is_valid_utf8_ptr_unsafe+ , c_is_valid_utf8_ptr_safe+ , c_is_valid_utf8_bytearray_unsafe+ , c_is_valid_utf8_bytearray_safe+ ) where++import Data.Word (Word8)+import Foreign.C.Types (CSize(..),CInt(..))+import GHC.Exts (Ptr,ByteArray#)++foreign import ccall unsafe "_hs_text_is_valid_utf8" c_is_valid_utf8_ptr_unsafe+ :: Ptr Word8 -- ^ Bytes+ -> CSize -- ^ Length+ -> IO CInt+foreign import ccall safe "_hs_text_is_valid_utf8" c_is_valid_utf8_ptr_safe+ :: Ptr Word8 -- ^ Bytes+ -> CSize -- ^ Length+ -> IO CInt+foreign import ccall unsafe "_hs_text_is_valid_utf8_offset" c_is_valid_utf8_bytearray_unsafe+ :: ByteArray# -- ^ Bytes+ -> CSize -- ^ Offset into bytes+ -> CSize -- ^ Length+ -> IO CInt+foreign import ccall safe "_hs_text_is_valid_utf8_offset" c_is_valid_utf8_bytearray_safe+ :: ByteArray# -- ^ Bytes+ -> CSize -- ^ Offset into bytes+ -> CSize -- ^ Length+ -> IO CInt
tests/Tests.hs view
@@ -9,10 +9,12 @@ import qualified Tests.Lift as Lift import qualified Tests.Properties as Properties import qualified Tests.Regressions as Regressions+import qualified Tests.RebindableSyntaxTest as RST main :: IO () main = defaultMain $ testGroup "All" [ Lift.tests , Properties.tests , Regressions.tests+ , RST.tests ]
tests/Tests/Properties/LowLevel.hs view
@@ -31,6 +31,7 @@ import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.IO.Utf8 as TU import qualified System.IO as IO #ifdef MIN_VERSION_tasty_inspection_testing@@ -107,6 +108,9 @@ tl_write_read_line m b t = write_read (TL.concat . take 1) TL.filter TL.hPutStrLn TL.hGetLine m b [t] +utf8_write_read = write_read T.unlines T.filter TU.hPutStr TU.hGetContents+utf8_write_read_line m b t = write_read (T.concat . take 1) T.filter TU.hPutStrLn+ TU.hGetLine m b [t] testLowLevel :: TestTree testLowLevel =@@ -142,7 +146,9 @@ testProperty "t_write_read" t_write_read, testProperty "tl_write_read" tl_write_read, testProperty "t_write_read_line" t_write_read_line,- testProperty "tl_write_read_line" tl_write_read_line+ testProperty "tl_write_read_line" tl_write_read_line,+ testProperty "utf8_write_read" utf8_write_read,+ testProperty "utf8_write_read_line" utf8_write_read_line -- These tests are subject to I/O race conditions -- testProperty "t_put_get" t_put_get, -- testProperty "tl_put_get" tl_put_get
tests/Tests/QuickCheckUtils.hs view
@@ -2,8 +2,9 @@ -- instances, and comparison functions, so we can focus on the actual properties -- in the 'Tests.Properties' module. ---{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -213,11 +214,13 @@ arbitrary = arbitraryPrecision 22 shrink = map Precision . shrink . precision undefined +#if !MIN_VERSION_QuickCheck(2,14,3) instance Arbitrary IO.Newline where arbitrary = oneof [return IO.LF, return IO.CRLF] instance Arbitrary IO.NewlineMode where arbitrary = IO.NewlineMode <$> arbitrary <*> arbitrary+#endif instance Arbitrary IO.BufferMode where arbitrary = oneof [ return IO.NoBuffering,
+ tests/Tests/RebindableSyntaxTest.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE RebindableSyntax, TemplateHaskell #-}++module Tests.RebindableSyntaxTest where++import qualified Data.Text as Text+import Language.Haskell.TH.Syntax (lift)+import Test.Tasty.HUnit (testCase, assertEqual)+import Test.Tasty (TestTree, testGroup)+import Prelude (($))++tests :: TestTree+tests = testGroup "RebindableSyntax"+ [ testCase "test" $ assertEqual "a" $(lift (Text.pack "a")) (Text.pack "a")+ ]
tests/Tests/Regressions.hs view
@@ -11,7 +11,7 @@ ) where import Control.Exception (SomeException, handle)-import Data.Char (isLetter)+import Data.Char (isLetter, chr) import GHC.Exts (Int(..), sizeofByteArray#) import System.IO import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure)@@ -23,6 +23,8 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Internal as T+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E+import qualified Data.Text.Internal.Lazy.Fusion as LF import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TB@@ -30,6 +32,7 @@ import qualified Data.Text.Unsafe as T import qualified Test.Tasty as F import qualified Test.Tasty.HUnit as F+import Test.Tasty.HUnit ((@?=)) import System.Directory (removeFile) import Tests.Utils (withTempFile)@@ -145,6 +148,34 @@ (decodeL (LB.fromChunks [B.pack [194], B.pack [97, 98, 99]])) (decodeL (LB.fromChunks [B.pack [194, 97, 98, 99]])) +-- Stream decoders should not loop on incomplete code points+t525 :: IO ()+t525 = do+ let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs)+ decodeUtf8With E.lenientDecode "\xC0" @?= "\65533"+ LE.decodeUtf16BEWith E.lenientDecode "\0" @?= "\65533"+ LE.decodeUtf16LEWith E.lenientDecode "\0" @?= "\65533"+ LE.decodeUtf32BEWith E.lenientDecode "\0" @?= "\65533"+ LE.decodeUtf32LEWith E.lenientDecode "\0" @?= "\65533"++-- Stream decoders skip one invalid byte at a time+t528 :: IO ()+t528 = do+ let decodeUtf8With onErr bs = LF.unstream (E.streamUtf8 onErr bs)+ decodeUtf8With E.lenientDecode "\xC0\xF0\x90\x80\x80" @?= "\65533\65536"+ LE.decodeUtf16BEWith E.lenientDecode "\xD8\xD8\x00\xDC\x00" @?= "\65533\65536"+ LE.decodeUtf16LEWith E.lenientDecode "\xD8\xD8\x00\xD8\x00\xDC" @?= "\65533\65533\65536"+ LE.decodeUtf32BEWith E.lenientDecode "\xFF\x00\x00\x00\x00" @?= "\65533\0"+ LE.decodeUtf32LEWith E.lenientDecode "\x00\x00\xFF\x00\x00" @?= "\65533\65280"++t529 :: IO ()+t529 = do+ let decode = TE.decodeUtf8With E.lenientDecode+ -- https://github.com/haskell/bytestring/issues/575+ assertEqual "Data.ByteString.isValidUtf8 should work correctly"+ (T.pack (chr 33 : replicate 31 (chr 0) ++ [chr 65533, chr 0]))+ (decode (B.pack (33 : replicate 31 0 ++ [128, 0])))+ tests :: F.TestTree tests = F.testGroup "Regressions" [ F.testCase "hGetContents_crash" hGetContents_crash@@ -159,4 +190,7 @@ , F.testCase "t280/singleton" t280_singleton , F.testCase "t301" t301 , F.testCase "t330" t330+ , F.testCase "t525" t525+ , F.testCase "t528" t528+ , F.testCase "t529" t529 ]
text.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: text-version: 2.0.2+version: 2.1 homepage: https://github.com/haskell/text bug-reports: https://github.com/haskell/text/issues@@ -52,8 +52,10 @@ GHC == 8.8.4 GHC == 8.10.7 GHC == 9.0.2- GHC == 9.2.4- GHC == 9.4.1+ GHC == 9.2.8+ GHC == 9.4.6+ GHC == 9.6.2+ GHC == 9.8.1 extra-source-files: -- scripts/CaseFolding.txt@@ -73,7 +75,7 @@ manual: True flag simdutf- description: use simdutf library+ description: use simdutf library, causes Data.Text.Internal.Validate.Simd to be exposed default: True manual: True @@ -85,6 +87,7 @@ hs-source-dirs: src if flag(simdutf)+ exposed-modules: Data.Text.Internal.Validate.Simd include-dirs: simdutf cxx-sources: simdutf/simdutf.cpp cbits/validate_utf8.cpp@@ -102,17 +105,12 @@ extra-libraries: stdc++ else extra-libraries: c++ c++abi- elif os(linux)- extra-libraries: stdc++- else- -- This is supposed to be under arch(wasm32), but we can't do that yet- -- since cabal check would fail with unrecognized arch, see- -- https://github.com/haskell/cabal/pull/8096 for the fix.- -- TODO: when a new cabal release is out with that fix, bump cabal in CI- -- and add proper arch(wasm32) declaration here.+ elif arch(wasm32) cpp-options: -DSIMDUTF_NO_THREADS cxx-options: -fno-exceptions extra-libraries: c++ c++abi+ else+ extra-libraries: stdc++ -- Certain version of GHC crash on Windows, when TemplateHaskell encounters C++. -- https://gitlab.haskell.org/ghc/ghc/-/issues/19417@@ -143,6 +141,7 @@ Data.Text.Encoding.Error Data.Text.Foreign Data.Text.IO+ Data.Text.IO.Utf8 Data.Text.Internal Data.Text.Internal.Builder Data.Text.Internal.Builder.Functions@@ -172,6 +171,7 @@ Data.Text.Internal.StrictBuilder Data.Text.Internal.Unsafe Data.Text.Internal.Unsafe.Char+ Data.Text.Internal.Validate Data.Text.Lazy Data.Text.Lazy.Builder Data.Text.Lazy.Builder.Int@@ -190,11 +190,14 @@ array >= 0.3 && < 0.6, base >= 4.10 && < 5, binary >= 0.5 && < 0.9,- bytestring >= 0.10.4 && < 0.12,- deepseq >= 1.1 && < 1.5,- ghc-prim >= 0.2 && < 0.11,- template-haskell >= 2.5 && < 2.21+ bytestring >= 0.10.4 && < 0.13,+ deepseq >= 1.1 && < 1.6,+ ghc-prim >= 0.2 && < 0.12,+ template-haskell >= 2.5 && < 2.22 + if impl(ghc < 9.4)+ build-depends: data-array-byte >= 0.1 && < 0.2+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 if flag(developer) ghc-options: -fno-ignore-asserts@@ -249,6 +252,7 @@ Tests.Properties.Text Tests.Properties.Transcoding Tests.QuickCheckUtils+ Tests.RebindableSyntaxTest Tests.Regressions Tests.SlowFunctions Tests.Utils@@ -278,11 +282,7 @@ benchmark text-benchmarks type: exitcode-stdio-1.0 - ghc-options: -Wall -O2 -rtsopts- if impl(ghc >= 8.10)- ghc-options: "-with-rtsopts=-A32m --nonmoving-gc"- else- ghc-options: "-with-rtsopts=-A32m"+ ghc-options: -Wall -O2 -rtsopts "-with-rtsopts=-A32m" if impl(ghc >= 8.6) ghc-options: -fproc-alignment=64