debug-info test
This commit is contained in:
parent
83b82c328b
commit
bcdf2b23f1
@ -417,6 +417,8 @@ test-suite ghcup-optparse-test
|
|||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
SetTest
|
SetTest
|
||||||
|
Utils
|
||||||
|
DebugInfoTest
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
18
test/optparse-test/DebugInfoTest.hs
Normal file
18
test/optparse-test/DebugInfoTest.hs
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
module DebugInfoTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.HUnit
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
|
debugInfoTests :: TestTree
|
||||||
|
debugInfoTests =
|
||||||
|
testGroup "debug-info" $ pure
|
||||||
|
$ testCase "1. debug-info" $ do
|
||||||
|
res <- parseWith ["debug-info"]
|
||||||
|
liftIO $ assertBool "debug-info parse failed" (isDInfo res)
|
||||||
|
where
|
||||||
|
isDInfo :: Command -> Bool
|
||||||
|
isDInfo DInfo = True
|
||||||
|
isDInfo _ = False
|
@ -1,6 +1,10 @@
|
|||||||
module Main where
|
module Main where
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import qualified SetTest
|
import qualified SetTest
|
||||||
|
import qualified DebugInfoTest
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain SetTest.setTests
|
main = defaultMain $ testGroup "ghcup"
|
||||||
|
[ SetTest.setTests
|
||||||
|
, DebugInfoTest.debugInfoTests
|
||||||
|
]
|
@ -5,12 +5,11 @@ module SetTest where
|
|||||||
import GHCup.OptParse as GHCup
|
import GHCup.OptParse as GHCup
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Options.Applicative
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
import Data.Bifunctor (second)
|
import Utils
|
||||||
|
|
||||||
setTests :: TestTree
|
setTests :: TestTree
|
||||||
setTests =
|
setTests =
|
||||||
@ -190,15 +189,3 @@ setParseWith :: [String] -> IO (Either SetCommand SetOptions)
|
|||||||
setParseWith args = do
|
setParseWith args = do
|
||||||
Set a <- parseWith args
|
Set a <- parseWith args
|
||||||
pure a
|
pure a
|
||||||
|
|
||||||
parseWith :: [String] -> IO Command
|
|
||||||
parseWith args =
|
|
||||||
optCommand <$> handleParseResult
|
|
||||||
(execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
|
|
||||||
|
|
||||||
padLeft :: Int -> String -> String
|
|
||||||
padLeft desiredLength s = padding ++ s
|
|
||||||
where padding = replicate (desiredLength - length s) ' '
|
|
||||||
|
|
||||||
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
|
|
||||||
mapSecond = map . second
|
|
||||||
|
17
test/optparse-test/Utils.hs
Normal file
17
test/optparse-test/Utils.hs
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
module Utils where
|
||||||
|
|
||||||
|
import GHCup.OptParse as GHCup
|
||||||
|
import Options.Applicative
|
||||||
|
import Data.Bifunctor
|
||||||
|
|
||||||
|
parseWith :: [String] -> IO Command
|
||||||
|
parseWith args =
|
||||||
|
optCommand <$> handleParseResult
|
||||||
|
(execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
|
||||||
|
|
||||||
|
padLeft :: Int -> String -> String
|
||||||
|
padLeft desiredLength s = padding ++ s
|
||||||
|
where padding = replicate (desiredLength - length s) ' '
|
||||||
|
|
||||||
|
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
|
||||||
|
mapSecond = map . second
|
Loading…
Reference in New Issue
Block a user