summaryrefslogtreecommitdiff
path: root/source/Test/Unit/Abstract.hs
diff options
context:
space:
mode:
Diffstat (limited to 'source/Test/Unit/Abstract.hs')
-rw-r--r--source/Test/Unit/Abstract.hs114
1 files changed, 0 insertions, 114 deletions
diff --git a/source/Test/Unit/Abstract.hs b/source/Test/Unit/Abstract.hs
deleted file mode 100644
index 61118bd..0000000
--- a/source/Test/Unit/Abstract.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Test.Unit.Abstract (unitTests) where
-
-import Base
-import Report.Location
-import 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