1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Foundation.String
( testStringRefs
) where
-- import Control.Monad (replicateM)
import Foundation
import Foundation.Check
import Foundation.String
import Foundation.Primitive (AsciiString)
import Test.Data.List
import Test.Checks.Property.Collection
--import Test.Foundation.Encoding
testStringRefs :: Test
testStringRefs = Group "String"
[ Group "UTF8" $
[ collectionProperties "String" (Proxy :: Proxy String) arbitrary ]
<> testStringCases
{-
<> [ testGroup "Encoding Sample0" (testEncodings sample0)
, testGroup "Encoding Sample1" (testEncodings sample1)
, testGroup "Encoding Sample2" (testEncodings sample2)
]
-}
, Group "ASCII" $
[ collectionProperties "AsciiString" (Proxy :: Proxy AsciiString) arbitrary ]
-- <> testAsciiStringCases
]
testStringCases :: [Test]
testStringCases =
[ Group "Validation"
[ Property "fromBytes . toBytes == valid" $ \l ->
let s = fromList l
in (fromBytes UTF8 $ toBytes UTF8 s) === (s, Nothing, mempty)
, Property "Streaming" $ \(l, randomInts) ->
let wholeS = fromList l
wholeBA = toBytes UTF8 wholeS
reconstruct (prevBa, errs, acc) ba =
let ba' = prevBa `mappend` ba
(s, merr, nextBa) = fromBytes UTF8 ba'
in (nextBa, merr : errs, s : acc)
(remainingBa, allErrs, chunkS) = foldl' reconstruct (mempty, [], []) $ chunks randomInts wholeBA
in (catMaybes allErrs === []) `propertyAnd` (remainingBa === mempty) `propertyAnd` (mconcat (reverse chunkS) === wholeS)
]
, Group "ModifiedUTF8"
[ propertyModifiedUTF8 "The foundation Serie" "基地系列" "基地系列"
, propertyModifiedUTF8 "has null bytes" "let's\0 do \0 it" "let's\0 do \0 it"
, propertyModifiedUTF8 "Vincent's special" "abc\0안, 蠀\0, ☃" "abc\0안, 蠀\0, ☃"
, propertyModifiedUTF8 "Long string"
"this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"
"this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"
]
, Group "CaseMapping"
[ Property "upper . upper == upper" $ \l ->
let s = fromList l
in upper (upper s) === upper s
, CheckPlan "a should capitalize to A" $ validate "a" $ upper "a" == "A"
, CheckPlan "b should capitalize to B" $ validate "b" $ upper "b" == "B"
, CheckPlan "B should not capitalize" $ validate "B" $ upper "B" == "B"
, CheckPlan "é should capitalize to É" $ validate "é" $ upper "é" == "É"
, CheckPlan "ß should capitalize to SS" $ validate "ß" $ upper "ß" == "SS"
, CheckPlan "ffl should capitalize to FFL" $ validate "ffl" $ upper "fflfflfflfflfflfflfflfflfflffl" == "FFLFFLFFLFFLFFLFFLFFLFFLFFLFFL"
, CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "\0a" == "\0A"
, CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "a\0a" == "A\0A"
, CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "\0\0" == "\0\0"
, CheckPlan "00 should not capitalize" $ validate "00" $ upper "00" == "00"
]
{-
, testGroup "replace" [
testCase "indices '' 'bb' should raise an error" $ do
res <- try (evaluate $ indices "" "bb")
case res of
(Left (_ :: SomeException)) -> return ()
Right _ -> fail "Expecting an error to be thrown, but it did not."
, testCase "indices 'aa' 'bb' == []" $ do
indices "aa" "bb" @?= []
, testCase "indices 'aa' 'aabbccabbccEEaaaaabb' is correct" $ do
indices "aa" "aabbccabbccEEaaaaabb" @?= [Offset 0,Offset 13,Offset 15]
, testCase "indices 'aa' 'aaccaadd' is correct" $ do
indices "aa" "aaccaadd" @?= [Offset 0,Offset 4]
, testCase "replace '' 'bb' 'foo' raises an error" $ do
(res :: Either SomeException String) <- try (evaluate $ replace "" "bb" "foo")
assertBool "Expecting an error to be thrown, but it did not." (isLeft res)
, testCase "replace 'aa' 'bb' '' == ''" $ do
replace "aa" "bb" "" @?= ""
, testCase "replace 'aa' '' 'aabbcc' == 'aabbcc'" $ do
replace "aa" "" "aabbcc" @?= "bbcc"
, testCase "replace 'aa' 'bb' 'aa' == 'bb'" $ do
replace "aa" "bb" "aa" @?= "bb"
, testCase "replace 'aa' 'bb' 'aabb' == 'bbbb'" $ do
replace "aa" "bb" "aabb" @?= "bbbb"
, testCase "replace 'aa' 'bb' 'aaccaadd' == 'bbccbbdd'" $ do
replace "aa" "bb" "aaccaadd" @?= "bbccbbdd"
, testCase "replace 'aa' 'LongLong' 'aaccaadd' == 'LongLongccLongLongdd'" $ do
replace "aa" "LongLong" "aaccaadd" @?= "LongLongccLongLongdd"
, testCase "replace 'aa' 'bb' 'aabbccabbccEEaaaaabb' == 'bbbbccabbccEEbbbbabb'" $ do
replace "aa" "bb" "aabbccabbccEEaaaaabb" @?= "bbbbccabbccEEbbbbabb"
, testCase "replace 'å' 'ä' 'ååññ' == 'ääññ'" $ do
replace "å" "ä" "ååññ" @?= "ääññ"
]
, testGroup "Cases"
[ testGroup "Invalid-UTF8"
[ testCase "ff" $ expectFromBytesErr UTF8 ("", Just InvalidHeader, 0) (fromList [0xff])
, testCase "80" $ expectFromBytesErr UTF8 ("", Just InvalidHeader, 0) (fromList [0x80])
, testCase "E2 82 0C" $ expectFromBytesErr UTF8 ("", Just InvalidContinuation, 0) (fromList [0xE2,0x82,0x0c])
, testCase "30 31 E2 82 0C" $ expectFromBytesErr UTF8 ("01", Just InvalidContinuation, 2) (fromList [0x30,0x31,0xE2,0x82,0x0c])
]
]
, testGroup "Lines"
[ testCase "Hello<LF>Foundation" $
(breakLine "Hello\nFoundation" @?= Right ("Hello", "Foundation"))
, testCase "Hello<CRLF>Foundation" $
(breakLine "Hello\r\nFoundation" @?= Right ("Hello", "Foundation"))
, testCase "Hello<LF>Foundation" $
(breakLine (drop 5 "Hello\nFoundation\nSomething") @?= Right ("", "Foundation\nSomething"))
, testCase "Hello<CR>" $
(breakLine "Hello\r" @?= Left True)
, testCase "CR" $
(breakLine "\r" @?= Left True)
, testCase "LF" $
(breakLine "\n" @?= Right ("", ""))
, testCase "empty" $
(breakLine "" @?= Left False)
]
-}
]
{-
testAsciiStringCases :: [Test]
testAsciiStringCases =
[ Group "Validation-ASCII7"
[ Property "fromBytes . toBytes == valid" $ \l ->
let s = fromList . fromLStringASCII $ l
in (fromBytes ASCII7 $ toBytes ASCII7 s) === (s, Nothing, mempty)
, Property "Streaming" $ \(l, randomInts) ->
let wholeS = fromList . fromLStringASCII $ l
wholeBA = toBytes ASCII7 wholeS
reconstruct (prevBa, errs, acc) ba =
let ba' = prevBa `mappend` ba
(s, merr, nextBa) = fromBytes ASCII7 ba'
in (nextBa, merr : errs, s : acc)
(remainingBa, allErrs, chunkS) = foldl' reconstruct (mempty, [], []) $ chunks randomInts wholeBA
in (catMaybes allErrs === []) .&&. (remainingBa === mempty) .&&. (mconcat (reverse chunkS) === wholeS)
]
, Group "Cases"
[ Group "Invalid-ASCII7"
[ testCase "ff" $ expectFromBytesErr ASCII7 ("", Just BuildingFailure, 0) (fromList [0xff])
]
]
]
expectFromBytesErr :: Encoding -> ([Char], Maybe ValidationFailure, CountOf Word8) -> UArray Word8 -> IO ()
expectFromBytesErr enc (expectedString,expectedErr,positionErr) ba = do
let x = fromBytes enc ba
(s', merr, ba') = x
assertEqual "error" expectedErr merr
assertEqual "remaining" (drop positionErr ba) ba'
assertEqual "string" expectedString (toList s')
-}
propertyModifiedUTF8 :: String -> [Char] -> String -> Test
propertyModifiedUTF8 name chars str = Property name $ chars === toList str
chunks :: Sequential c => RandomList -> c -> [c]
chunks (RandomList randomInts) = loop (randomInts <> [1..])
where
loop rx c
| null c = []
| otherwise =
case rx of
r:rs ->
let (c1,c2) = splitAt (CountOf r) c
in c1 : loop rs c2
[] ->
loop randomInts c
|
