Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

standalone tests for cabal init #7424

Merged
merged 8 commits into from
Jun 24, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 7 additions & 1 deletion cabal-install/src/Distribution/Client/Init/FlagExtractors.hs
Original file line number Diff line number Diff line change
Expand Up @@ -135,7 +135,11 @@ getExtraDocFiles = pure

-- | Ask whether the project builds a library or executable.
getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
getPackageType flags = fromFlagOrPrompt (packageType flags)
getPackageType InitFlags
{ initializeTestSuite = Flag True
, packageType = NoFlag
} _ = return TestSuite
getPackageType flags act = fromFlagOrPrompt (packageType flags) act
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Nice. that's easy i suppose.


getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
getMainFile flags act = case mainIs flags of
Expand Down Expand Up @@ -238,12 +242,14 @@ packageTypePrompt flags = getPackageType flags $ do
[ "Library"
, "Executable"
, "Library and Executable"
, "Test suite"
]

parsePackageType = \case
"Library" -> Just Library
"Executable" -> Just Executable
"Library and Executable" -> Just LibraryAndExecutable
"Test suite" -> Just TestSuite
_ -> Nothing

testMainPrompt :: Interactive m => m HsFilePath
Expand Down
14 changes: 14 additions & 0 deletions cabal-install/src/Distribution/Client/Init/Interactive/Command.hs
Original file line number Diff line number Diff line change
Expand Up @@ -137,6 +137,20 @@ createProject v pkgIx srcDb initFlags = do
return $ ProjectSettings
(mkOpts comments cabalSpec) pkgDesc (Just libTarget)
(Just exeTarget) testTarget

TestSuite -> do
-- the line below is necessary because if both package type and test flags
-- are *not* passed, the user will be prompted for a package type (which
-- includes TestSuite in the list). It prevents that the user end up with a
-- TestSuite target with initializeTestSuite set to NoFlag, thus avoiding the prompt.
let initFlags' = initFlags { initializeTestSuite = Flag True }
Mikolaj marked this conversation as resolved.
Show resolved Hide resolved
testTarget <- genTestTarget initFlags' pkgIx

comments <- noCommentsPrompt initFlags'

return $ ProjectSettings
(mkOpts comments cabalSpec) pkgDesc
Nothing Nothing testTarget
where
-- Add package name as dependency of test suite
--
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -136,6 +136,13 @@ createProject comp v pkgIx srcDb initFlags = do
return $ ProjectSettings
(mkOpts comments cabalSpec) pkgDesc (Just libTarget)
(Just exeTarget) testTarget

TestSuite -> do
testTarget <- genTestTarget initFlags comp pkgIx cabalSpec

return $ ProjectSettings
(mkOpts comments cabalSpec) pkgDesc
Nothing Nothing testTarget

genPkgDescription
:: Interactive m
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -122,20 +122,28 @@ guessExtraDocFiles flags = do
-- looking for unique characteristics from each type, defaults to Executable.
guessPackageType :: Interactive m => InitFlags -> m PackageType
guessPackageType flags = do
let lastDir dirs = L.last . splitDirectories $ dirs
srcCandidates = [defaultSourceDir, "src", "source"]
testCandidates = [defaultTestDir, "test", "tests"]

pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
files <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir

let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]

return $ case (hasLib, hasExe) of
(True, True) -> LibraryAndExecutable
(True, False) -> Library
_ -> Executable
if fromFlagOrDefault False (initializeTestSuite flags)
then
return TestSuite
else do
let lastDir dirs = L.last . splitDirectories $ dirs
srcCandidates = [defaultSourceDir, "src", "source"]
testCandidates = [defaultTestDir, "test", "tests"]

pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
files <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
files' <- filter (not . null . map (`elem` testCandidates) . splitDirectories) <$>
listFilesRecursive pkgDir

let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]
hasTest = not $ null [f | f <- files', isMain $ takeFileName f]

return $ case (hasLib, hasExe, hasTest) of
(True , True , _ ) -> LibraryAndExecutable
(True , False, _ ) -> Library
(False, False, True) -> TestSuite
_ -> Executable

-- | Try to guess the application directories from the package directory,
-- using a default value as fallback.
Expand Down
6 changes: 6 additions & 0 deletions cabal-install/src/Distribution/Client/Init/Simple.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,12 @@ createProject v _pkgIx _srcDb initFlags = do
return $ ProjectSettings
(mkOpts False cabalSpec) pkgDesc
(Just libTarget) (Just exeTarget) testTarget

TestSuite -> do
testTarget <- genSimpleTestTarget initFlags
return $ ProjectSettings
(mkOpts False cabalSpec) pkgDesc
Nothing Nothing testTarget
where
-- Add package name as dependency of test suite
--
Expand Down
4 changes: 2 additions & 2 deletions cabal-install/src/Distribution/Client/Init/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -210,9 +210,9 @@ data ProjectSettings = ProjectSettings
-- Other types

-- | Enum to denote whether the user wants to build a library target,
-- executable target, or library and executable targets.
-- executable target, library and executable targets, or a standalone test suite.
--
data PackageType = Library | Executable | LibraryAndExecutable
data PackageType = Library | Executable | LibraryAndExecutable | TestSuite
deriving (Eq, Show, Generic)

data HsFileType
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/src/Distribution/Client/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2135,7 +2135,7 @@ initOptions _ =
(noArg (Flag IT.LibraryAndExecutable))

, option [] ["tests"]
"Generate a test suite for the library."
"Generate a test suite, standalone or for a library."
IT.initializeTestSuite
(\v flags -> flags { IT.initializeTestSuite = v })
trueArg
Expand Down
32 changes: 31 additions & 1 deletion cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ import Test.Tasty.HUnit

import qualified Data.ByteString.Lazy.Char8 as BS8
import Data.List.NonEmpty (fromList)
import Data.List.NonEmpty as NEL (NonEmpty)
import Data.List.NonEmpty as NEL (NonEmpty, drop)
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup ((<>))
#endif
Expand Down Expand Up @@ -214,6 +214,16 @@ goldenTestTests v pkgIx pkgDir pkgName = testGroup "test golden tests"
(goldenTest "test-build-tools-with-comments.golden") $
let opts = WriteOpts False False False v pkgDir Library pkgName defaultCabalVersion
in runGoldenTest opts testArgs (emptyFlags {buildTools = Flag ["happy"]})

, goldenVsString "Standalone tests, empty flags, not simple, no options"
(goldenTest "standalone-test.golden") $
let opts = WriteOpts False False True v pkgDir TestSuite pkgName defaultCabalVersion
in runGoldenTest opts testArgs emptyFlags

, goldenVsString "Standalone tests, empty flags, not simple, with comments + no minimal"
(goldenTest "standalone-test-with-comments.golden") $
let opts = WriteOpts False False False v pkgDir TestSuite pkgName defaultCabalVersion
in runGoldenTest opts testArgs emptyFlags
]
where
runGoldenTest opts args flags =
Expand Down Expand Up @@ -245,6 +255,14 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
, goldenVsString "Library, empty flags, not simple, no comments + no minimal"
(goldenCabal "cabal-lib-no-comments.golden") $
runGoldenTest (libProjArgs "N") emptyFlags

, goldenVsString "Test suite, empty flags, not simple, with comments + no minimal"
(goldenCabal "cabal-test-suite-with-comments.golden") $
runGoldenTest (testProjArgs "Y") emptyFlags

, goldenVsString "Test suite, empty flags, not simple, no comments + no minimal"
(goldenCabal "cabal-test-suite-no-comments.golden") $
runGoldenTest (testProjArgs "N") emptyFlags
]
where
runGoldenTest args flags =
Expand All @@ -265,6 +283,12 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}

mkStanza $ pkgFields ++ [libStanza, testStanza]

(Right (ProjectSettings opts pkgDesc Nothing Nothing (Just testTarget), _)) -> do
let pkgFields = mkPkgDescription opts pkgDesc
testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}

mkStanza $ pkgFields ++ [testStanza]

(Right (ProjectSettings _ _ l e t, _)) -> assertFailure $
show l ++ "\n" ++ show e ++ "\n" ++ show t
Expand Down Expand Up @@ -319,6 +343,12 @@ pkgArgs = fromList
, "4"
]

testProjArgs :: String -> NonEmpty String
testProjArgs comments = fromList ["4", "foo-package"]
<> pkgArgs
<> fromList (NEL.drop 1 testArgs)
<> fromList [comments]

libProjArgs :: String -> NonEmpty String
libProjArgs comments = fromList ["1", "foo-package"]
<> pkgArgs
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
-- language
, "2"
-- test target
, "y"
-- main file
, "1"
-- test dir
Expand All @@ -174,7 +175,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
, "y"
]

case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
_optOverwrite opts @?= False
_optMinimal opts @?= False
Expand Down Expand Up @@ -258,6 +259,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
-- language
, "2"
-- test target
, "y"
-- main file
, "1"
-- test dir
Expand All @@ -268,7 +270,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
, "y"
]

case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
_optOverwrite opts @?= False
_optMinimal opts @?= False
Expand Down Expand Up @@ -311,6 +313,79 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
exe @?= Nothing
test @?! Nothing
Left e -> assertFailure $ show e

, testCase "Check the interactive library workflow" $ do
let inputs = fromList
-- package type
[ "4"
-- package dir
, "test-package"
-- package description
-- cabal version
, "4"
-- package name
, "test-package"
, "test-package"
-- version
, "3.1.2.3"
-- license
, "3"
-- author
, "Foobar"
-- email
, "[email protected]"
-- homepage
, "qux.com"
-- synopsis
, "Qux's package"
-- category
, "3"
-- test target
-- main file
, "1"
-- test dir
, "test"
-- language
, "1"
-- comments
, "y"
]

case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
Right (ProjectSettings opts desc Nothing Nothing (Just test), _) -> do
_optOverwrite opts @?= False
_optMinimal opts @?= False
_optNoComments opts @?= False
_optVerbosity opts @?= silent
_optPkgDir opts @?= "/home/test/test-package"
_optPkgType opts @?= TestSuite
_optPkgName opts @?= mkPackageName "test-package"

_pkgCabalVersion desc @?= CabalSpecV2_4
_pkgName desc @?= mkPackageName "test-package"
_pkgVersion desc @?= mkVersion [3,1,2,3]
_pkgLicense desc @?! SPDX.NONE
_pkgAuthor desc @?= "Foobar"
_pkgEmail desc @?= "[email protected]"
_pkgHomePage desc @?= "qux.com"
_pkgSynopsis desc @?= "Qux's package"
_pkgCategory desc @?= "Control"
_pkgExtraSrcFiles desc @?= mempty
_pkgExtraDocFiles desc @?= pure (Set.singleton "CHANGELOG.md")

_testMainIs test @?= HsFilePath "Main.hs" Standard
_testDirs test @?= ["test"]
_testLanguage test @?= Haskell2010
_testOtherModules test @?= []
_testOtherExts test @?= []
_testDependencies test @?! []
_testBuildTools test @?= []

Right (ProjectSettings _ _ lib exe test, _) -> do
lib @?= Nothing
exe @?= Nothing
test @?! Nothing
Left e -> assertFailure $ show e
]
, testGroup "without tests"
[ testCase "Check the interactive library and executable workflow" $ do
Expand Down Expand Up @@ -668,13 +743,13 @@ fileCreatorTests pkgIx srcDb _pkgName = testGroup "generators"
, testGroup "genTestTarget"
[ testCase "Check test package flags workflow" $ do
let inputs = fromList
[ "1" -- pick the first main file option in the list
[ "y" -- say yes to tests
, "1" -- pick the first main file option in the list
, "test" -- package test dir
, "1" -- pick the first language in the list
]

runGenTest inputs $ genTestTarget
(emptyFlags {initializeTestSuite = Flag True}) pkgIx
runGenTest inputs $ genTestTarget emptyFlags pkgIx
]
]
where
Expand Down
Loading