packages feed

cleveland-0.1.0: test/TestSuite/Cleveland/Tasty.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module TestSuite.Cleveland.Tasty
  ( test_Memoize
  , test_OptionsCombinations
  ) where

import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Options (OptionSet, singleOption)
import Test.Tasty.Runners (TreeFold(..), foldTestTree, trivialFold)

import Test.Cleveland.Internal.Scenario
import Test.Cleveland.Tasty.Internal
  (loadOptionSwitcher, memoize, testScenario, testScenarioOnEmulator, testScenarioOnNetwork)
import Test.Cleveland.Tasty.Internal.Options (RunModeOpt(..))

test_Memoize :: TestTree
test_Memoize =
  testGroup "memoize"
    [ testCase "is lazy" $ do
        ioref <- newIORef @_ @Int 1

        _action <- memoize (modifyIORef ioref succ)

        val <- readIORef ioref
        val @?= 1

    , testCase "writes only once to cache" $ do
        ioref <- newIORef @_ @Int 1

        action <- memoize (modifyIORef ioref succ)
        action
        action
        action

        val <- readIORef ioref
        val @?= 2
    ]

test_OptionsCombinations :: TestTree
test_OptionsCombinations =
  testGroup "Test possible option combinations" $
    [ testGroup "Tests when CI is Unset" $
      [ testCase "Mode is not specified" $
        getTestNames mempty sampleTestTreeUnset @?= onlyEmulatorResult ++ hunitResult
      , testCase "RunAllMode is used" $
        getTestNames (singleOption RunAllMode)  sampleTestTreeUnset @?= fullResult ++ hunitResult
      , testCase "NoRunNetworkMode is used" $
        getTestNames (singleOption DisableNetworkMode)  sampleTestTreeUnset @?= onlyEmulatorResult ++ hunitResult
      , testCase "RunOnlyNetworkMode is used" $
        getTestNames (singleOption OnlyNetworkMode)  sampleTestTreeUnset @?= onlyNetworkResult
      ]
    , testGroup "Tests when CI is Set" $
      [ testCase "Mode is not specified" $
        getTestNames mempty sampleTestTreeSet @?= fullResult ++ hunitResult
      , testCase "RunAllMode is used" $
        getTestNames (singleOption RunAllMode)  sampleTestTreeSet @?= fullResult ++ hunitResult
      , testCase "NoRunNetworkMode is used" $
        getTestNames (singleOption DisableNetworkMode)  sampleTestTreeSet @?= onlyEmulatorResult ++ hunitResult
      , testCase "RunOnlyNetworkMode is used" $
        getTestNames (singleOption OnlyNetworkMode)  sampleTestTreeSet @?= onlyNetworkResult
      ]
    ]
  where
    getTestNames :: OptionSet -> TestTree -> [String]
    getTestNames =
      foldTestTree
        trivialFold
          { foldSingle = \_ name _ -> [name]
          , foldGroup = \_opts n l -> map ((n ++ ".") ++) l
          }
    sampleTestTreeSet :: TestTree
    sampleTestTreeSet = loadOptionSwitcher True $ testGroup "Tests"
      [ testScenario "test on both network and emulator" $ scenario pass
      , testScenarioOnEmulator "test only on emulator" $ scenarioEmulated pass
      , testScenarioOnNetwork "test only on network" $ scenario pass
      , testCase "hunit test" pass
      ]

    sampleTestTreeUnset :: TestTree
    sampleTestTreeUnset = loadOptionSwitcher False $ testGroup "Tests"
      [ testScenario "test on both network and emulator" $ scenario pass
      , testScenarioOnEmulator "test only on emulator" $ scenarioEmulated pass
      , testScenarioOnNetwork "test only on network" $ scenario pass
      , testCase "hunit test" pass
      ]

    fullResult :: [String]
    fullResult =
      [ "Tests.test on both network and emulator.On emulator"
      , "Tests.test on both network and emulator.On network"
      , "Tests.test only on emulator.On emulator"
      , "Tests.test only on network.On network"
      ]

    onlyEmulatorResult :: [String]
    onlyEmulatorResult =
      [ "Tests.test on both network and emulator.On emulator"
      , "Tests.test only on emulator.On emulator"
      ]

    onlyNetworkResult :: [String]
    onlyNetworkResult =
      [ "Tests.test on both network and emulator.On network"
      , "Tests.test only on network.On network"
      ]

    hunitResult :: [String]
    hunitResult = ["Tests.hunit test"]