Skip to content

Commit 486710d

Browse files
adithyaovadithyaov
committed
Move common parser test utils into its own module
1 parent bbac52d commit 486710d

3 files changed

Lines changed: 187 additions & 161 deletions

File tree

‎test/Streamly/Test/Data/Parser.hs‎

Lines changed: 2 additions & 160 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ import Data.Char (isSpace)
1010
import Data.Foldable (for_)
1111
import Data.Word (Word8, Word32, Word64)
1212
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
13+
import Streamly.Internal.Data.Parser (ParseError(..))
1314
import Test.QuickCheck
1415
(arbitrary, forAll, elements, Property, property, listOf,
1516
vectorOf, Gen, (.&&.))
@@ -32,12 +33,12 @@ import qualified Test.Hspec as H
3233

3334
import Test.Hspec
3435
import Test.Hspec.QuickCheck
36+
import Streamly.Test.Parser.Common
3537

3638
#if MIN_VERSION_QuickCheck(2,14,0)
3739

3840
import Test.QuickCheck (chooseAny)
3941
import Control.Monad.Identity (Identity(runIdentity, Identity))
40-
import Streamly.Internal.Data.Parser (ParseError(..))
4142

4243
#else
4344

@@ -1306,165 +1307,6 @@ quotedWordTest inp expected = do
13061307
-- Parser sanity tests
13071308
--------------------------------------------------------------------------------
13081309

1309-
data Move
1310-
= Consume Int
1311-
| Custom (P.Step () ())
1312-
deriving (Show)
1313-
1314-
jumpParser :: Monad m => [Move] -> P.Parser Int m [Int]
1315-
jumpParser jumps = P.Parser step initial done
1316-
where
1317-
initial = pure $ P.IPartial (jumps, [])
1318-
1319-
step ([], buf) _ = pure $ P.Done 1 (reverse buf)
1320-
step (action:xs, buf) a =
1321-
case action of
1322-
Consume n
1323-
| n == 1 -> pure $ P.Continue 0 (xs, a:buf)
1324-
| n > 0 -> pure $ P.Continue 0 (Consume (n - 1) : xs, a:buf)
1325-
| otherwise -> error "Cannot consume <= 0"
1326-
Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf)
1327-
Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf)
1328-
Custom (P.Done i ()) -> pure $ P.Done i (reverse buf)
1329-
Custom (P.Error err) -> pure $ P.Error err
1330-
1331-
done ([], buf) = pure $ P.Done 0 (reverse buf)
1332-
done (action:xs, buf) =
1333-
case action of
1334-
Consume _ -> pure $ P.Error "INCOMPLETE"
1335-
Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf)
1336-
Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf)
1337-
Custom (P.Done i ()) -> pure $ P.Done i (reverse buf)
1338-
Custom (P.Error err) -> pure $ P.Error err
1339-
1340-
chunkedTape :: [[Int]]
1341-
chunkedTape = Prelude.map (\x -> [x..(x+9)]) [1, 11 .. 91]
1342-
1343-
tape :: [Int]
1344-
tape = concat chunkedTape
1345-
1346-
tapeLen :: Int
1347-
tapeLen = length tape
1348-
1349-
expectedResult :: [Move] -> [Int] -> (Either ParseError [Int], [Int])
1350-
expectedResult moves inp = go 0 0 [] moves
1351-
where
1352-
inpLen = length inp
1353-
1354-
slice off len = Prelude.take len . Prelude.drop off
1355-
slice_ off = Prelude.drop off
1356-
1357-
-- i = Index of inp head
1358-
-- j = Minimum index of inp head
1359-
go i j ys [] = (Right ys, slice_ (max i j) inp)
1360-
go i j ys ((Consume n):xs)
1361-
| i + n > inpLen = (Left (ParseError "INCOMPLETE"), drop j inp)
1362-
| otherwise =
1363-
go (i + n) j (ys ++ slice i n inp) xs
1364-
go i j ys ((Custom step):xs)
1365-
| i > inpLen = error "i > inpLen"
1366-
| i == inpLen =
1367-
-- Where there is no input we do not move forward by default.
1368-
-- Hence it is (i - n) and not (i + 1 - n)
1369-
case step of
1370-
P.Partial n () -> go (i - n) (max j (i - n)) ys xs
1371-
P.Continue n () -> go (i - n) j ys xs
1372-
P.Done n () -> (Right ys, slice_ (max (i - n) j) inp)
1373-
P.Error err -> (Left (ParseError err), slice_ j inp)
1374-
| otherwise =
1375-
case step of
1376-
P.Partial n () -> go (i + 1 - n) (max j (i + 1 - n)) ys xs
1377-
P.Continue n () -> go (i + 1 - n) j ys xs
1378-
P.Done n () -> (Right ys, slice_ (max (i - n + 1) j) inp)
1379-
P.Error err -> (Left (ParseError err), slice_ j inp)
1380-
1381-
expectedResultMany :: [Move] -> [Int] -> [Either ParseError [Int]]
1382-
expectedResultMany _ [] = []
1383-
expectedResultMany moves inp =
1384-
let (res, rest) = expectedResult moves inp
1385-
in
1386-
case res of
1387-
Left err -> [Left err]
1388-
Right val -> Right val : expectedResultMany moves rest
1389-
1390-
createPaths :: [a] -> [[a]]
1391-
createPaths xs =
1392-
Prelude.map (flip Prelude.take xs) [1..length xs]
1393-
1394-
parserSanityTests :: String -> ([Move] -> SpecWith ()) -> SpecWith ()
1395-
parserSanityTests desc testRunner =
1396-
describe desc $ do
1397-
Prelude.mapM_ testRunner $
1398-
createPaths
1399-
[ Consume (tapeLen + 1)
1400-
]
1401-
Prelude.mapM_ testRunner $
1402-
createPaths
1403-
[ Custom (P.Error "Message0")
1404-
]
1405-
Prelude.mapM_ testRunner $
1406-
createPaths
1407-
[ Consume 10
1408-
, Custom (P.Partial 0 ())
1409-
, Consume 10
1410-
, Custom (P.Partial 1 ())
1411-
, Consume 10
1412-
, Custom (P.Partial 11 ())
1413-
, Consume 10
1414-
, Custom (P.Continue 0 ())
1415-
, Consume 10
1416-
, Custom (P.Continue 1 ())
1417-
, Consume 10
1418-
, Custom (P.Continue 11 ())
1419-
, Custom (P.Error "Message1")
1420-
]
1421-
Prelude.mapM_ testRunner $
1422-
createPaths
1423-
[ Consume 10
1424-
, Custom (P.Continue 0 ())
1425-
, Consume 10
1426-
, Custom (P.Continue 1 ())
1427-
, Consume 10
1428-
, Custom (P.Continue 11 ())
1429-
, Consume 10
1430-
, Custom (P.Done 0 ())
1431-
]
1432-
Prelude.mapM_ testRunner $
1433-
createPaths
1434-
[ Consume 20
1435-
, Custom (P.Continue 0 ())
1436-
, Custom (P.Continue 11 ())
1437-
, Custom (P.Done 1 ())
1438-
]
1439-
Prelude.mapM_ testRunner $
1440-
createPaths
1441-
[ Consume 20
1442-
, Custom (P.Continue 0 ())
1443-
, Custom (P.Continue 11 ())
1444-
, Custom (P.Error "Message2")
1445-
]
1446-
Prelude.mapM_ testRunner $
1447-
createPaths
1448-
[ Consume 20
1449-
, Custom (P.Continue 0 ())
1450-
, Custom (P.Continue 11 ())
1451-
, Custom (P.Done 5 ())
1452-
]
1453-
Prelude.mapM_ testRunner $
1454-
createPaths
1455-
[ Consume tapeLen
1456-
, Custom (P.Continue 0 ())
1457-
, Custom (P.Continue 10 ())
1458-
, Custom (P.Done 5 ())
1459-
]
1460-
Prelude.mapM_ testRunner $
1461-
createPaths
1462-
[ Consume tapeLen
1463-
, Custom (P.Continue 0 ())
1464-
, Custom (P.Continue 10 ())
1465-
, Custom (P.Error "Message3")
1466-
]
1467-
14681310
{-
14691311
TODO:
14701312
Add sanity tests for

‎test/lib/Streamly/Test/Parser/Common.hs‎

Lines changed: 182 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,182 @@
1+
module Streamly.Test.Parser.Common
2+
( Move(..)
3+
, jumpParser
4+
, chunkedTape
5+
, tape
6+
, tapeLen
7+
, expectedResult
8+
, expectedResultMany
9+
, parserSanityTests
10+
)
11+
where
12+
13+
--------------------------------------------------------------------------------
14+
-- Imports
15+
--------------------------------------------------------------------------------
16+
17+
import Streamly.Internal.Data.Parser (ParseError(..))
18+
import qualified Streamly.Internal.Data.Parser as P
19+
import Test.Hspec
20+
21+
--------------------------------------------------------------------------------
22+
-- Parser driver tests
23+
--------------------------------------------------------------------------------
24+
25+
data Move
26+
= Consume Int
27+
| Custom (P.Step () ())
28+
deriving (Show)
29+
30+
jumpParser :: Monad m => [Move] -> P.Parser Int m [Int]
31+
jumpParser jumps = P.Parser step initial done
32+
where
33+
initial = pure $ P.IPartial (jumps, [])
34+
35+
step ([], buf) _ = pure $ P.Done 1 (reverse buf)
36+
step (action:xs, buf) a =
37+
case action of
38+
Consume n
39+
| n == 1 -> pure $ P.Continue 0 (xs, a:buf)
40+
| n > 0 -> pure $ P.Continue 0 (Consume (n - 1) : xs, a:buf)
41+
| otherwise -> error "Cannot consume <= 0"
42+
Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf)
43+
Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf)
44+
Custom (P.Done i ()) -> pure $ P.Done i (reverse buf)
45+
Custom (P.Error err) -> pure $ P.Error err
46+
47+
done ([], buf) = pure $ P.Done 0 (reverse buf)
48+
done (action:xs, buf) =
49+
case action of
50+
Consume _ -> pure $ P.Error "INCOMPLETE"
51+
Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf)
52+
Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf)
53+
Custom (P.Done i ()) -> pure $ P.Done i (reverse buf)
54+
Custom (P.Error err) -> pure $ P.Error err
55+
56+
chunkedTape :: [[Int]]
57+
chunkedTape = Prelude.map (\x -> [x..(x+9)]) [1, 11 .. 91]
58+
59+
tape :: [Int]
60+
tape = concat chunkedTape
61+
62+
tapeLen :: Int
63+
tapeLen = length tape
64+
65+
expectedResult :: [Move] -> [Int] -> (Either ParseError [Int], [Int])
66+
expectedResult moves inp = go 0 0 [] moves
67+
where
68+
inpLen = length inp
69+
70+
slice off len = Prelude.take len . Prelude.drop off
71+
slice_ off = Prelude.drop off
72+
73+
-- i = Index of inp head
74+
-- j = Minimum index of inp head
75+
go i j ys [] = (Right ys, slice_ (max i j) inp)
76+
go i j ys ((Consume n):xs)
77+
| i + n > inpLen = (Left (ParseError "INCOMPLETE"), drop j inp)
78+
| otherwise =
79+
go (i + n) j (ys ++ slice i n inp) xs
80+
go i j ys ((Custom step):xs)
81+
| i > inpLen = error "i > inpLen"
82+
| i == inpLen =
83+
-- Where there is no input we do not move forward by default.
84+
-- Hence it is (i - n) and not (i + 1 - n)
85+
case step of
86+
P.Partial n () -> go (i - n) (max j (i - n)) ys xs
87+
P.Continue n () -> go (i - n) j ys xs
88+
P.Done n () -> (Right ys, slice_ (max (i - n) j) inp)
89+
P.Error err -> (Left (ParseError err), slice_ j inp)
90+
| otherwise =
91+
case step of
92+
P.Partial n () -> go (i + 1 - n) (max j (i + 1 - n)) ys xs
93+
P.Continue n () -> go (i + 1 - n) j ys xs
94+
P.Done n () -> (Right ys, slice_ (max (i - n + 1) j) inp)
95+
P.Error err -> (Left (ParseError err), slice_ j inp)
96+
97+
expectedResultMany :: [Move] -> [Int] -> [Either ParseError [Int]]
98+
expectedResultMany _ [] = []
99+
expectedResultMany moves inp =
100+
let (res, rest) = expectedResult moves inp
101+
in
102+
case res of
103+
Left err -> [Left err]
104+
Right val -> Right val : expectedResultMany moves rest
105+
106+
createPaths :: [a] -> [[a]]
107+
createPaths xs =
108+
Prelude.map (flip Prelude.take xs) [1..length xs]
109+
110+
parserSanityTests :: String -> ([Move] -> SpecWith ()) -> SpecWith ()
111+
parserSanityTests desc testRunner =
112+
describe desc $ do
113+
Prelude.mapM_ testRunner $
114+
createPaths
115+
[ Consume (tapeLen + 1)
116+
]
117+
Prelude.mapM_ testRunner $
118+
createPaths
119+
[ Custom (P.Error "Message0")
120+
]
121+
Prelude.mapM_ testRunner $
122+
createPaths
123+
[ Consume 10
124+
, Custom (P.Partial 0 ())
125+
, Consume 10
126+
, Custom (P.Partial 1 ())
127+
, Consume 10
128+
, Custom (P.Partial 11 ())
129+
, Consume 10
130+
, Custom (P.Continue 0 ())
131+
, Consume 10
132+
, Custom (P.Continue 1 ())
133+
, Consume 10
134+
, Custom (P.Continue 11 ())
135+
, Custom (P.Error "Message1")
136+
]
137+
Prelude.mapM_ testRunner $
138+
createPaths
139+
[ Consume 10
140+
, Custom (P.Continue 0 ())
141+
, Consume 10
142+
, Custom (P.Continue 1 ())
143+
, Consume 10
144+
, Custom (P.Continue 11 ())
145+
, Consume 10
146+
, Custom (P.Done 0 ())
147+
]
148+
Prelude.mapM_ testRunner $
149+
createPaths
150+
[ Consume 20
151+
, Custom (P.Continue 0 ())
152+
, Custom (P.Continue 11 ())
153+
, Custom (P.Done 1 ())
154+
]
155+
Prelude.mapM_ testRunner $
156+
createPaths
157+
[ Consume 20
158+
, Custom (P.Continue 0 ())
159+
, Custom (P.Continue 11 ())
160+
, Custom (P.Error "Message2")
161+
]
162+
Prelude.mapM_ testRunner $
163+
createPaths
164+
[ Consume 20
165+
, Custom (P.Continue 0 ())
166+
, Custom (P.Continue 11 ())
167+
, Custom (P.Done 5 ())
168+
]
169+
Prelude.mapM_ testRunner $
170+
createPaths
171+
[ Consume tapeLen
172+
, Custom (P.Continue 0 ())
173+
, Custom (P.Continue 10 ())
174+
, Custom (P.Done 5 ())
175+
]
176+
Prelude.mapM_ testRunner $
177+
createPaths
178+
[ Consume tapeLen
179+
, Custom (P.Continue 0 ())
180+
, Custom (P.Continue 10 ())
181+
, Custom (P.Error "Message3")
182+
]

‎test/streamly-tests.cabal‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -182,7 +182,9 @@ common lib-options
182182
library
183183
import: lib-options, test-dependencies
184184
hs-source-dirs: lib
185-
exposed-modules: Streamly.Test.Common
185+
exposed-modules:
186+
Streamly.Test.Common
187+
Streamly.Test.Parser.Common
186188
if !flag(use-streamly-core)
187189
exposed-modules: Streamly.Test.Prelude.Common
188190
if flag(limit-build-mem)

0 commit comments

Comments
 (0)