blob: c487c2a45d1595b843ecabe2fca3ad2080b143b7 (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
module Felix.Test.Unit.Abstract (unitTests) where
import Base
import Felix.Report.Location
import Felix.Syntax.Abstract
import Hedgehog
import Hedgehog.Gen qualified as Gen
import Test.Tasty
import Test.Tasty.HUnit hiding (assert)
import Test.Tasty.Hedgehog (testPropertyNamed)
unitTests :: TestTree
unitTests =
testGroup "Abstract syntax"
[ testPropertyNamed
"noun phrase ordering obeys the Ord laws"
"prop_nounPhraseOrd"
prop_nounPhraseOrd
, testCase
"noun phrase fields survive ordered deduplication"
nounPhraseFieldsRemainDistinct
]
prop_nounPhraseOrd :: Property
prop_nounPhraseOrd = withTests 100 . property $ do
x <- forAll nounPhrase
y <- forAll nounPhrase
z <- forAll nounPhrase
(compare x y == EQ) === (x == y)
compare x y === oppositeOrdering (compare y x)
assert (not (x <= y && y <= z) || x <= z)
nounPhraseFieldsRemainDistinct :: Assertion
nounPhraseFieldsRemainDistinct =
assertEqual
"one value per base and changed field"
6
(length
(nubOrd
[ sampleNounPhrase False False False False False
, sampleNounPhrase True False False False False
, sampleNounPhrase False True False False False
, sampleNounPhrase False False True False False
, sampleNounPhrase False False False True False
, sampleNounPhrase False False False False True
]))
nounPhrase :: Gen (NounPhraseOf Maybe Int)
nounPhrase =
sampleNounPhrase
<$> Gen.bool
<*> Gen.bool
<*> Gen.bool
<*> Gen.bool
<*> Gen.bool
sampleNounPhrase
:: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> NounPhraseOf Maybe Int
sampleNounPhrase hasLeft otherNoun hasName hasRight hasSuchThat =
NounPhrase
[AdjL Nowhere leftAdjective [1] | hasLeft]
(Noun
Nowhere
(if otherNoun then secondNoun else firstNoun)
[2])
(NamedVar "x" <$ guardMaybe hasName)
[AdjR Nowhere rightAdjective [3] | hasRight]
(truthStatement <$ guardMaybe hasSuchThat)
where
guardMaybe condition =
if condition then Just () else Nothing
leftAdjective :: LexicalItem
leftAdjective =
mkLexicalItem [Just (Word "left")] "left"
rightAdjective :: LexicalItem
rightAdjective =
mkLexicalItem [Just (Word "right")] "right"
firstNoun :: LexicalItemSgPl
firstNoun =
mkLexicalItemSgPl
(SgPl
[Just (Word "first")]
[Just (Word "firsts")])
"first"
secondNoun :: LexicalItemSgPl
secondNoun =
mkLexicalItemSgPl
(SgPl
[Just (Word "second")]
[Just (Word "seconds")])
"second"
truthStatement :: Stmt
truthStatement =
StmtFormula (PropositionalConstant Nowhere IsTop)
oppositeOrdering :: Ordering -> Ordering
oppositeOrdering = \case
LT -> GT
EQ -> EQ
GT -> LT
|
