Skip to content

Commit

Permalink
Issue #73: make sure all exported tests are executed (#75)
Browse files Browse the repository at this point in the history
  • Loading branch information
Marko Dimjašević authored Oct 25, 2019
1 parent 0706f78 commit 9a33c7e
Show file tree
Hide file tree
Showing 5 changed files with 43 additions and 55 deletions.
9 changes: 5 additions & 4 deletions test/Fencer/Logic/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,15 +2,13 @@
{-# LANGUAGE OverloadedStrings #-}

-- | Tests for "Fencer.Logic".
module Fencer.Logic.Test
( test_logicLimitUnitChange
) where
module Fencer.Logic.Test (tests) where

import BasePrelude

import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import Test.Tasty (TestTree)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)

import Fencer.Counter (CounterStatus, counterRemainingLimit)
Expand All @@ -20,6 +18,9 @@ import Fencer.Server.Test (withServer, serverAppState)
import Fencer.Types


tests :: TestTree
tests = testGroup "Logic tests" [test_logicLimitUnitChange]

-- | Test that a rule limit unit change adds a new counter and leaves
-- the old one intact.
test_logicLimitUnitChange :: TestTree
Expand Down
18 changes: 10 additions & 8 deletions test/Fencer/Rules/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,7 @@
{-# LANGUAGE OverloadedLabels #-}

-- | Tests for "Fencer.Rules".
module Fencer.Rules.Test
( test_rulesLoadRulesYaml
, test_rulesLoadRulesNonYaml
, test_rulesLoadRulesRecursively
)
where
module Fencer.Rules.Test (tests) where

import BasePrelude

Expand All @@ -19,14 +14,21 @@ import NeatInterpolation (text)
import qualified System.IO.Temp as Temp
import System.FilePath ((</>))
import System.Directory (createDirectoryIfMissing)
import Test.Tasty (TestTree)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)

import Fencer.Rules
import Fencer.Types


-- | Test that 'loadRulesFromDirectory' loads rules from YAML files.
tests :: TestTree
tests = testGroup "Rule tests"
[ test_rulesLoadRulesYaml
, test_rulesLoadRulesNonYaml
, test_rulesLoadRulesRecursively
]

-- | test that 'loadRulesFromDirectory' loads rules from YAML files.
test_rulesLoadRulesYaml :: TestTree
test_rulesLoadRulesYaml =
testCase "Rules are loaded from YAML files" $
Expand Down
8 changes: 6 additions & 2 deletions test/Fencer/Server/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,15 +4,15 @@

-- | Tests for "Fencer.Server".
module Fencer.Server.Test
( test_serverResponseNoRules
( tests
, withServer
, serverAppState
)
where

import BasePrelude

import Test.Tasty (TestTree, withResource)
import Test.Tasty (TestTree, testGroup, withResource)
import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)
import qualified System.Logger as Logger
import qualified System.IO.Temp as Temp
Expand All @@ -28,6 +28,10 @@ import qualified Fencer.Proto as Proto
-- Tests
----------------------------------------------------------------------------

tests :: TestTree
tests = testGroup "Server tests" [ test_serverResponseNoRules ]


-- | Test that when Fencer is started without any rules provided to it (i.e.
-- 'reloadRules' has never been ran), requests to Fencer will error out.
--
Expand Down
20 changes: 11 additions & 9 deletions test/Fencer/Types/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,7 @@
{-# LANGUAGE TypeApplications #-}

-- | Tests for types from the "Fencer.Types" module.
module Fencer.Types.Test
( test_parseJSONDescriptorDefinition
, test_parseJSONDomainDefinition
, test_parseJSONDomainAtLeastOneDescriptor
, test_parseJSONNonEmptyDomainId
, test_parseJSONOptionalDescriptorFields
)
where
module Fencer.Types.Test (tests) where

import BasePrelude

Expand All @@ -19,10 +12,19 @@ import Data.Aeson.QQ (aesonQQ)
import Data.Aeson.Types (parseEither, Value(..))
import Data.List.NonEmpty (NonEmpty((:|)))
import Fencer.Types (DescriptorDefinition(..), DomainDefinition(..), DomainId(..), RateLimit(..), RuleKey(..), RuleValue(..), TimeUnit(..))
import Test.Tasty (TestTree)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)


tests :: TestTree
tests = testGroup "Type tests"
[ test_parseJSONDescriptorDefinition
, test_parseJSONDomainDefinition
, test_parseJSONDomainAtLeastOneDescriptor
, test_parseJSONNonEmptyDomainId
, test_parseJSONOptionalDescriptorFields
]

descriptor1 :: Value
descriptor1 = [aesonQQ|
{
Expand Down
43 changes: 11 additions & 32 deletions test/Main.hs
Original file line number Diff line number Diff line change
@@ -1,48 +1,27 @@
-- test/Main.hs
module Main where

import Test.Tasty (after, defaultMain, testGroup, DependencyType(AllFinish), TestTree)

import BasePrelude

import qualified Fencer.Logic.Test as L
import qualified Fencer.Rules.Test as R
import qualified Fencer.Server.Test as S
import qualified Fencer.Types.Test as T
import qualified Fencer.Logic.Test
import qualified Fencer.Rules.Test
import qualified Fencer.Server.Test
import qualified Fencer.Types.Test


tests :: TestTree
tests = testGroup "All tests"
[ types
, logic
, rules
-- 'after' is needed to avoid running the 'logic' and 'server' tests
[ Fencer.Types.Test.tests
, Fencer.Logic.Test.tests
, Fencer.Rules.Test.tests
-- 'after' is needed to avoid running the 'rules' and 'server' tests
-- concurrently. Running them concurrently is problematic because
-- both create a server (binding the same port) so if they create it
-- at the same time, one of the test groups will fail. The 'after'
-- function makes the 'server' tests run after the 'logic' tests.
, after AllFinish "test_logic" server
]

logic :: TestTree
logic = testGroup "Logic tests" [L.test_logicLimitUnitChange]

server :: TestTree
server = testGroup "Server tests" [S.test_serverResponseNoRules]

rules :: TestTree
rules = testGroup "Rule tests"
[ R.test_rulesLoadRulesYaml
, R.test_rulesLoadRulesNonYaml
, R.test_rulesLoadRulesRecursively
]

types :: TestTree
types = testGroup "Type tests"
[ T.test_parseJSONDescriptorDefinition
, T.test_parseJSONDomainDefinition
, T.test_parseJSONDomainAtLeastOneDescriptor
, T.test_parseJSONNonEmptyDomainId
, T.test_parseJSONOptionalDescriptorFields
-- function makes 'server' tests run after 'rules' tests.
, after AllFinish "test_logic" Fencer.Server.Test.tests
]


Expand Down

0 comments on commit 9a33c7e

Please sign in to comment.