84cddd0 · text · git.iko.soy

git.iko.soy/text

Fix tests build

commit84cddd0a5e1753af9949dc9e428c3fcada50f28d authorLuigy Leon <luigy@outlook.com> dateMon 20 Aug 2018, 22:17 (8 years ago) parent78f714d

10 files changed+154−6

compare with master

unifiedsplit

Data/Text/Encoding.hs+7−1 Data/Text/Foreign.hs+87−1 Data/Text/Internal.hs+5 Data/Text/Internal/Builder.hs+4 Data/Text/Internal/Lazy/Search.hs+16 Data/Text/Internal/Search.hs+1 tests/Tests/Properties.hs+6 tests/Tests/QuickCheckUtils.hs+3−3 tests/Tests/SlowFunctions.hs+22 text.cabal+3−1

Data/Text/Encoding.hs+7−1

@@ -401,7 +401,13 @@ encodeUtf8BuilderEscaped be =

401401#ifdef __GHCJS__

402402 off = 0

403403 (arr, len) = let (# ba, len' #) = js_fromString t

404− in (A.Array ba, I# len')

404+#if defined(ASSERTS)

405+ in ( A.Array ba (I# len')

406+#else

407+ in ( A.Array ba

408+#endif

409+ , I# len'

410+ )

405411#endif

406412 iend = off + len

407413

Data/Text/Foreign.hs+87−1

@@ -1,4 +1,5 @@

11{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}

23-- |

34-- Module : Data.Text.Foreign

@@ -50,6 +51,13 @@ import Foreign.Marshal.Alloc (allocaBytes)

5051import Foreign.Ptr (Ptr, castPtr, plusPtr)

5152import Foreign.Storable (peek, poke)

5253import qualified Data.Text.Array as A

54+#ifdef __GHCJS__

55+import Data.JSString (JSString)

56+import GHC.Exts (ByteArray#, Int#)

57+import GHC.Prim (int2Word#)

58+import GHC.Int (Int(..))

59+import GHC.Word (Word16(..))

60+#endif

5361

5462-- $interop

5563--

@@ -74,11 +82,15 @@ fromPtr :: Ptr Word16 -- ^ source array

7482 -> I16 -- ^ length of source array (in 'Word16' units)

7583 -> IO Text

7684fromPtr _ (I16 0) = return empty

77−fromPtr ptr (I16 len) =

85+fromPtr ptr (I16 (len@(I# len#))) =

7886#if defined(ASSERTS)

7987 assert (len > 0) $

8088#endif

89+#if defined(__GHCJS__)

90+ return $! Text (js_toString (A.aBA arr) 0# len#)

91+#else

8192 return $! Text arr 0 len

93+#endif

8294 where

8395 arr = A.run (A.new len >>= copy)

8496 copy marr = loop ptr 0

@@ -102,14 +114,30 @@ fromPtr ptr (I16 len) =

102114-- end of the prefix will be advanced by one additional 'Word16' unit

103115-- to maintain its validity.

104116takeWord16 :: I16 -> Text -> Text

117+#ifdef __GHCJS__

118+takeWord16 (I16 n@(I# n#)) t@(Text jss)

119+ | n <= 0 = empty

120+ | n >= len || m >= len = t

121+ | otherwise = Text (js_substr 0# n# jss)

122+#else

105123takeWord16 (I16 n) t@(Text arr off len)

106124 | n <= 0 = empty

107125 | n >= len || m >= len = t

108126 | otherwise = Text arr off m

127+#endif

109128 where

129+#ifdef __GHCJS__

130+ len = js_length jss

131+ arr = js_length jss

132+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n

133+ | otherwise = n+1

134+ w = I# w#

135+ w# = js_charCodeAt (n-1) jss

136+#else

110137 m | w < 0xD800 || w > 0xDBFF = n

111138 | otherwise = n+1

112139 w = A.unsafeIndex arr (off+n-1)

140+#endif

113141

114142-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units

115143-- dropped from its beginning.

@@ -118,18 +146,45 @@ takeWord16 (I16 n) t@(Text arr off len)

118146-- beginning of the suffix will be advanced by one additional 'Word16'

119147-- unit to maintain its validity.

120148dropWord16 :: I16 -> Text -> Text

149+#ifdef __GHCJS__

150+dropWord16 (I16 n@(I# n#)) t@(Text jss)

151+ | n <= 0 = t

152+ | n >= len || m >= len = empty

153+ | otherwise = Text (js_substr1 n# jss)

154+#else

121155dropWord16 (I16 n) t@(Text arr off len)

122156 | n <= 0 = t

123157 | n >= len || m >= len = empty

124158 | otherwise = Text arr (off+m) (len-m)

159+#endif

125160 where

161+#ifdef __GHCJS__

162+ len = js_length jss

163+ arr = js_length jss

164+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n

165+ | otherwise = n+1

166+ w = I# w#

167+ w# = js_charCodeAt (n-1) jss

168+#else

126169 m | w < 0xD800 || w > 0xDBFF = n

127170 | otherwise = n+1

128171 w = A.unsafeIndex arr (off+n-1)

172+#endif

129173

130174-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big

131175-- enough to hold the contents of the entire 'Text'.

132176unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()

177+#ifdef __GHCJS__

178+unsafeCopyToPtr (Text jst) ptr = loop ptr off

179+ where

180+ end = off + len

181+ loop !p !i | i == end = return ()

182+ | otherwise = do

183+ poke p (W16# (int2Word# (js_charCodeAt i jst)))

184+ loop (p `plusPtr` 2) (i + 1)

185+ off = 0

186+ len = js_length jst

187+#else

133188unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

134189 where

135190 end = off + len

@@ -137,21 +192,38 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

137192 | otherwise = do

138193 poke p (A.unsafeIndex arr i)

139194 loop (p `plusPtr` 2) (i + 1)

195+#endif

140196

141197-- | /O(n)/ Perform an action on a temporary, mutable copy of a

142198-- 'Text'. The copy is freed as soon as the action returns.

143199useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a

200+#ifdef __GHCJS__

201+useAsPtr t@(Text jst) action =

202+ allocaBytes (len * 2) $ \buf -> do

203+ unsafeCopyToPtr t buf

204+ action (castPtr buf) (fromIntegral len)

205+ where len = js_length jst

206+#else

144207useAsPtr t@(Text _arr _off len) action =

145208 allocaBytes (len * 2) $ \buf -> do

146209 unsafeCopyToPtr t buf

147210 action (castPtr buf) (fromIntegral len)

211+#endif

148212

149213-- | /O(n)/ Make a mutable copy of a 'Text'.

150214asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)

215+#ifdef __GHCJS__

216+asForeignPtr t@(Text jst) = do

217+ fp <- mallocForeignPtrArray len

218+ withForeignPtr fp $ unsafeCopyToPtr t

219+ return (fp, I16 len)

220+ where len = js_length jst

221+#else

151222asForeignPtr t@(Text _arr _off len) = do

152223 fp <- mallocForeignPtrArray len

153224 withForeignPtr fp $ unsafeCopyToPtr t

154225 return (fp, I16 len)

226+#endif

155227

156228-- | /O(n)/ Decode a C string with explicit length, which is assumed

157229-- to have been encoded as UTF-8. If decoding fails, a

@@ -174,3 +246,17 @@ peekCStringLen cs = do

174246-- @since 1.0.0.0

175247withCStringLen :: Text -> (CStringLen -> IO a) -> IO a

176248withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act

249+

250+#ifdef __GHCJS__

251+foreign import javascript unsafe

252+ "h$textToString($1,$2,$3)"

253+ js_toString :: ByteArray# -> Int# -> Int# -> JSString

254+foreign import javascript unsafe

255+ "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString

256+foreign import javascript unsafe

257+ "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString

258+foreign import javascript unsafe

259+ "$1.length" js_length :: JSString -> Int

260+foreign import javascript unsafe

261+ "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#

262+#endif

Data/Text/Internal.hs+5

@@ -60,8 +60,13 @@ foreign import javascript unsafe

6060text :: A.Array -> Int -> Int -> Text

6161-- text arr off len | len == 0 = empty

6262-- | otherwise = text_ arr off len

63+#if defined(ASSERTS)

64+text (A.Array ba _) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

65+ | otherwise = Text $ js_textToString ba off# len#

66+#else

6367text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

6468 | otherwise = Text $ js_textToString ba off# len#

69+#endif

6570

6671-- | Checked multiplication. Calls 'error' if the result would

6772-- overflow.

Data/Text/Internal/Builder.hs+4

@@ -174,7 +174,11 @@ fromText t@(Text t')

174174 | otherwise = flush `append` mapBuilder (t :)

175175 where

176176 (# ba, len #) = js_fromString t'

177+#if defined(ASSERTS)

178+ (arr, off, l) = (A.Array ba (I# len), 0, I# len)

179+#else

177180 (arr, off, l) = (A.Array ba, 0, I# len)

181+#endif

178182-- fromText t@(Text arr off l)

179183-- | S.null t = empty

180184-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

Data/Text/Internal/Lazy/Search.hs+16

@@ -94,7 +94,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

9494 let foff = 0

9595 (farr, flen) =

9696 let (# ba, len #) = fromString t

97+#if defined(ASSERTS)

98+ in (A.Array ba (I# len), I# len)

99+#else

97100 in (A.Array ba, I# len)

101+#endif

98102 in A.unsafeIndex farr (foff+flen-1)

99103 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

100104 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

@@ -104,7 +108,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

104108 xoff = 0

105109 (xarr, xlen) =

106110 let (# ba, len #) = fromString t

111+#if defined(ASSERTS)

112+ in (A.Array ba (I# len), I# len)

113+#else

107114 in (A.Array ba, I# len)

115+#endif

108116 go !(g::Int64) !i !msk !skp

109117 | i >= xlast = case xs of

110118 Empty -> (msk .|. swizzle z) :*: skp

@@ -148,7 +156,11 @@ index t xs !i

148156 off = 0

149157 (arr, len) =

150158 let (# ba, len' #) = fromString t

159+#if defined(ASSERTS)

160+ in (A.Array ba (I# len'), I# len')

161+#else

151162 in (A.Array ba, I# len')

163+#endif

152164

153165-- | A variant of 'indices' that scans linearly for a single 'Word16'.

154166indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

@@ -160,7 +172,11 @@ indicesOne c = chunk

160172 ooff = 0

161173 (oarr, olen) =

162174 let (# ba, len #) = fromString t

175+#if defined(ASSERTS)

176+ in (A.Array ba (I# len), I# len)

177+#else

163178 in (A.Array ba, I# len)

179+#endif

164180 go h | h >= olen = case os of

165181 Empty -> []

166182 Chunk y ys -> chunk (i+fromIntegral olen) y ys

Data/Text/Internal/Search.hs+1

@@ -31,6 +31,7 @@ module Data.Text.Internal.Search

3131 indices

3232 ) where

3333

34+import Data.Coerce

3435import qualified Data.Text.Array as A

3536import Data.Word (Word64)

3637import Data.Text.Internal (Text(..))

tests/Tests/Properties.hs+6

@@ -2,6 +2,7 @@

33{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

44 ScopedTypeVariables, TypeSynonymInstances #-}

5+{-# LANGUAGE CPP #-}

56{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

67module Tests.Properties

78 (

@@ -940,8 +941,13 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

940941-- functions that consume inaccurately sized streams behave

941942-- themselves.

942943shorten :: Int -> S.Stream a -> S.Stream a

944+#ifdef __GHCJS__

945+shorten n t@(S.Stream arr off)

946+ | n > 0 = S.Stream arr off -- TODO

947+#else

943948shorten n t@(S.Stream arr off len)

944949 | n > 0 = S.Stream arr off (smaller (exactSize n) len)

950+#endif

945951 | otherwise = t

946952

947953tests :: Test

tests/Tests/QuickCheckUtils.hs+3−3

@@ -157,9 +157,9 @@ shrinkNotEmpty isNull (NotEmpty xs) =

157157 [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]

158158

159159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

160+-- | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

161+-- | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

162+-- | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

163163 deriving (Eq, Ord, Enum, Bounded)

164164

165165small :: Integral a => Small -> a

tests/Tests/SlowFunctions.hs+22

@@ -1,4 +1,6 @@

11{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

3+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}

24module Tests.SlowFunctions

35 (

46 indices

@@ -8,18 +10,31 @@ module Tests.SlowFunctions

810import qualified Data.Text as T

911import Data.Text.Internal (Text(..))

1012import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)

13+#ifdef __GHCJS__

14+import Data.JSString (JSString)

15+#endif

1116

1217indices :: T.Text -- ^ Substring to search for (@needle@)

1318 -> T.Text -- ^ Text to search in (@haystack@)

1419 -> [Int]

20+#ifdef __GHCJS__

21+indices needle@(Text njst) haystack@(Text hjst)

22+#else

1523indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)

24+#endif

1625 | T.null needle = []

1726 | otherwise = scan 0

1827 where

1928 scan i | i >= hlen = []

2029 | needle `T.isPrefixOf` t = i : scan (i+nlen)

2130 | otherwise = scan (i+d)

31+#ifdef __GHCJS__

32+ where t = Text $ js_substr1 i hjst

33+ hlen = js_length hjst

34+ nlen = js_length njst

35+#else

2236 where t = Text harr (hoff+i) (hlen-i)

37+#endif

2338 d = iter_ haystack i

2439

2540splitOn :: T.Text -- ^ Text to split on

@@ -37,3 +52,10 @@ splitOn pat src0

3752 | T.null s = [src] -- not found

3853 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)

3954 | otherwise = search (n+1) (unsafeTail s)

55+

56+#ifdef __GHCJS__

57+foreign import javascript unsafe

58+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString

59+foreign import javascript unsafe

60+ "$1.length" js_length :: JSString -> Int

61+#endif

text.cabal+3−1

@@ -250,13 +250,15 @@ test-suite tests

250250

251251 build-depends:

252252 HUnit >= 1.2,

253− QuickCheck >= 2.7 && < 2.10,

253+ QuickCheck >= 2.7 && < 2.12,

254254 array,

255255 base,

256256 binary,

257257 deepseq,

258258 directory,

259259 ghc-prim,

260+ ghcjs-prim,

261+ ghcjs-base,

260262 quickcheck-unicode >= 1.0.1.0,

261263 random,

262264 test-framework >= 0.4,