-
Notifications
You must be signed in to change notification settings - Fork 12
/
test.hs
107 lines (90 loc) · 3.23 KB
/
test.hs
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
import Text.Regex.Applicative
import Text.Regex.Applicative.Reference
import Control.Applicative
import Control.Monad
import Data.Traversable
import Data.Maybe
import Text.Printf
import Test.SmallCheck
import Test.SmallCheck.Series
import Test.Framework
import Test.Framework.Providers.SmallCheck
-- Small alphabets as SmallCheck's series
newtype A = A { a :: Char } deriving Show
instance Serial A where
series = cons0 $ A 'a'
coseries = error "No coseries, sorry"
newtype AB = AB { ab :: Char } deriving Show
instance Serial AB where
series = cons0 (AB 'a') \/ cons0 (AB 'b')
coseries = error "No coseries, sorry"
newtype ABC = ABC { abc :: Char } deriving Show
instance Serial ABC where
series = cons0 (ABC 'a') \/ cons0 (ABC 'b') \/ cons0 (ABC 'c')
coseries = error "No coseries, sorry"
re1 =
let one = pure 1 <* sym 'a'
two = pure 2 <* sym 'a' <* sym 'a'
in (,) <$> (one <|> two) <*> (two <|> one)
re2 = sequenceA $
[ pure 1 <* sym 'a' <* sym 'a' <|>
pure 2 <* sym 'a'
, pure 3 <* sym 'b'
, pure 4 <* sym 'b' <|>
pure 5 <* sym 'a' ]
re3 = sequenceA $
[ pure 0 <|> pure 1
, pure 1 <* sym 'a' <* sym 'a' <|>
pure 2 <* sym 'a'
, pure 3 <* sym 'b' <|> pure 6
, fmap (+1) $
pure 4 <* sym 'b' <|>
pure 7 <|>
pure 5 <* sym 'a' ]
re4 = sym 'a' *> many (sym 'b') <* sym 'a'
re5 = (sym 'a' <|> sym 'a' *> sym 'a') *> many (sym 'a')
re6 = many (pure 3 <* sym 'a' <* sym 'a' <* sym 'a' <|> pure 1 <* sym 'a')
-- Regular expression from the weighted regexp paper.
re7 =
let many_A_or_B = many (sym 'a' <|> sym 'b')
in (,) <$>
many ((,,,) <$> many_A_or_B <*> sym 'c' <*> many_A_or_B <*> sym 'c') <*>
many_A_or_B
re8 = (,) <$> many (sym 'a' <|> sym 'b') <*> many (sym 'b' <|> sym 'c')
-- NB: we don't test these against the reference impl, 'cause it will loop!
re9 = many (sym 'a' <|> empty) <* sym 'b'
re10 = few (sym 'a' <|> empty) <* sym 'b'
prop re f s =
let fs = map f s in
reference re fs == (fs =~ re)
-- Because we have 2 slightly different algorithms for recognition and parsing,
-- we test that they agree
testRecognitionAgainstParsing re f (map f -> s) =
isJust (s =~ re) == isJust (s =~ (re *> pure ()))
tests =
[ testGroup "Engine tests"
[ t "re1" 10 $ prop re1 a
, t "re2" 10 $ prop re2 ab
, t "re3" 10 $ prop re3 ab
, t "re4" 10 $ prop re4 ab
, t "re5" 10 $ prop re5 a
, t "re6" 10 $ prop re6 a
, t "re7" 7 $ prop re7 abc
, t "re8" 7 $ prop re8 abc
]
, testGroup "Recognition vs parsing"
[ t "re1" 10 $ testRecognitionAgainstParsing re1 a
, t "re2" 10 $ testRecognitionAgainstParsing re2 ab
, t "re3" 10 $ testRecognitionAgainstParsing re3 ab
, t "re4" 10 $ testRecognitionAgainstParsing re4 ab
, t "re5" 10 $ testRecognitionAgainstParsing re5 a
, t "re6" 10 $ testRecognitionAgainstParsing re6 a
, t "re7" 7 $ testRecognitionAgainstParsing re7 abc
, t "re8" 7 $ testRecognitionAgainstParsing re8 abc
, t "re8" 10 $ testRecognitionAgainstParsing re9 ab
, t "re8" 10 $ testRecognitionAgainstParsing re10 ab
]
]
where
t name n = withDepth n . testProperty name
main = defaultMain tests