Skip to content

Commit 3675929

Browse files
ptkatoptkato
authored
Merge pull request #7424 from ptkato/cabal-init-standalone-tests
standalone tests for `cabal init`
2 parents f085beb + 7954c10 commit 3675929

File tree

17 files changed

+357
-38
lines changed

17 files changed

+357
-38
lines changed

‎cabal-install/src/Distribution/Client/Init/FlagExtractors.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -135,7 +135,11 @@ getExtraDocFiles = pure
135135

136136
-- | Ask whether the project builds a library or executable.
137137
getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
138-
getPackageType flags = fromFlagOrPrompt (packageType flags)
138+
getPackageType InitFlags
139+
{ initializeTestSuite = Flag True
140+
, packageType = NoFlag
141+
} _ = return TestSuite
142+
getPackageType flags act = fromFlagOrPrompt (packageType flags) act
139143

140144
getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
141145
getMainFile flags act = case mainIs flags of
@@ -238,12 +242,14 @@ packageTypePrompt flags = getPackageType flags $ do
238242
[ "Library"
239243
, "Executable"
240244
, "Library and Executable"
245+
, "Test suite"
241246
]
242247

243248
parsePackageType = \case
244249
"Library" -> Just Library
245250
"Executable" -> Just Executable
246251
"Library and Executable" -> Just LibraryAndExecutable
252+
"Test suite" -> Just TestSuite
247253
_ -> Nothing
248254

249255
testMainPrompt :: Interactive m => m HsFilePath

‎cabal-install/src/Distribution/Client/Init/Interactive/Command.hs

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -137,6 +137,20 @@ createProject v pkgIx srcDb initFlags = do
137137
return $ ProjectSettings
138138
(mkOpts comments cabalSpec) pkgDesc (Just libTarget)
139139
(Just exeTarget) testTarget
140+
141+
TestSuite -> do
142+
-- the line below is necessary because if both package type and test flags
143+
-- are *not* passed, the user will be prompted for a package type (which
144+
-- includes TestSuite in the list). It prevents that the user end up with a
145+
-- TestSuite target with initializeTestSuite set to NoFlag, thus avoiding the prompt.
146+
let initFlags' = initFlags { initializeTestSuite = Flag True }
147+
testTarget <- genTestTarget initFlags' pkgIx
148+
149+
comments <- noCommentsPrompt initFlags'
150+
151+
return $ ProjectSettings
152+
(mkOpts comments cabalSpec) pkgDesc
153+
Nothing Nothing testTarget
140154
where
141155
-- Add package name as dependency of test suite
142156
--

‎cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -136,6 +136,13 @@ createProject comp v pkgIx srcDb initFlags = do
136136
return $ ProjectSettings
137137
(mkOpts comments cabalSpec) pkgDesc (Just libTarget)
138138
(Just exeTarget) testTarget
139+
140+
TestSuite -> do
141+
testTarget <- genTestTarget initFlags comp pkgIx cabalSpec
142+
143+
return $ ProjectSettings
144+
(mkOpts comments cabalSpec) pkgDesc
145+
Nothing Nothing testTarget
139146

140147
genPkgDescription
141148
:: Interactive m

‎cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs

Lines changed: 22 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -122,20 +122,28 @@ guessExtraDocFiles flags = do
122122
-- looking for unique characteristics from each type, defaults to Executable.
123123
guessPackageType :: Interactive m => InitFlags -> m PackageType
124124
guessPackageType flags = do
125-
let lastDir dirs = L.last . splitDirectories $ dirs
126-
srcCandidates = [defaultSourceDir, "src", "source"]
127-
testCandidates = [defaultTestDir, "test", "tests"]
128-
129-
pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
130-
files <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
131-
132-
let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
133-
hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]
134-
135-
return $ case (hasLib, hasExe) of
136-
(True, True) -> LibraryAndExecutable
137-
(True, False) -> Library
138-
_ -> Executable
125+
if fromFlagOrDefault False (initializeTestSuite flags)
126+
then
127+
return TestSuite
128+
else do
129+
let lastDir dirs = L.last . splitDirectories $ dirs
130+
srcCandidates = [defaultSourceDir, "src", "source"]
131+
testCandidates = [defaultTestDir, "test", "tests"]
132+
133+
pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
134+
files <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
135+
files' <- filter (not . null . map (`elem` testCandidates) . splitDirectories) <$>
136+
listFilesRecursive pkgDir
137+
138+
let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
139+
hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]
140+
hasTest = not $ null [f | f <- files', isMain $ takeFileName f]
141+
142+
return $ case (hasLib, hasExe, hasTest) of
143+
(True , True , _ ) -> LibraryAndExecutable
144+
(True , False, _ ) -> Library
145+
(False, False, True) -> TestSuite
146+
_ -> Executable
139147

140148
-- | Try to guess the application directories from the package directory,
141149
-- using a default value as fallback.

‎cabal-install/src/Distribution/Client/Init/Simple.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,12 @@ createProject v _pkgIx _srcDb initFlags = do
6262
return $ ProjectSettings
6363
(mkOpts False cabalSpec) pkgDesc
6464
(Just libTarget) (Just exeTarget) testTarget
65+
66+
TestSuite -> do
67+
testTarget <- genSimpleTestTarget initFlags
68+
return $ ProjectSettings
69+
(mkOpts False cabalSpec) pkgDesc
70+
Nothing Nothing testTarget
6571
where
6672
-- Add package name as dependency of test suite
6773
--

‎cabal-install/src/Distribution/Client/Init/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -210,9 +210,9 @@ data ProjectSettings = ProjectSettings
210210
-- Other types
211211

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

218218
data HsFileType

‎cabal-install/src/Distribution/Client/Setup.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2135,7 +2135,7 @@ initOptions _ =
21352135
(noArg (Flag IT.LibraryAndExecutable))
21362136

21372137
, option [] ["tests"]
2138-
"Generate a test suite for the library."
2138+
"Generate a test suite, standalone or for a library."
21392139
IT.initializeTestSuite
21402140
(\v flags -> flags { IT.initializeTestSuite = v })
21412141
trueArg

‎cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ import Test.Tasty.HUnit
1111

1212
import qualified Data.ByteString.Lazy.Char8 as BS8
1313
import Data.List.NonEmpty (fromList)
14-
import Data.List.NonEmpty as NEL (NonEmpty)
14+
import Data.List.NonEmpty as NEL (NonEmpty, drop)
1515
#if __GLASGOW_HASKELL__ < 804
1616
import Data.Semigroup ((<>))
1717
#endif
@@ -214,6 +214,16 @@ goldenTestTests v pkgIx pkgDir pkgName = testGroup "test golden tests"
214214
(goldenTest "test-build-tools-with-comments.golden") $
215215
let opts = WriteOpts False False False v pkgDir Library pkgName defaultCabalVersion
216216
in runGoldenTest opts testArgs (emptyFlags {buildTools = Flag ["happy"]})
217+
218+
, goldenVsString "Standalone tests, empty flags, not simple, no options"
219+
(goldenTest "standalone-test.golden") $
220+
let opts = WriteOpts False False True v pkgDir TestSuite pkgName defaultCabalVersion
221+
in runGoldenTest opts testArgs emptyFlags
222+
223+
, goldenVsString "Standalone tests, empty flags, not simple, with comments + no minimal"
224+
(goldenTest "standalone-test-with-comments.golden") $
225+
let opts = WriteOpts False False False v pkgDir TestSuite pkgName defaultCabalVersion
226+
in runGoldenTest opts testArgs emptyFlags
217227
]
218228
where
219229
runGoldenTest opts args flags =
@@ -245,6 +255,14 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
245255
, goldenVsString "Library, empty flags, not simple, no comments + no minimal"
246256
(goldenCabal "cabal-lib-no-comments.golden") $
247257
runGoldenTest (libProjArgs "N") emptyFlags
258+
259+
, goldenVsString "Test suite, empty flags, not simple, with comments + no minimal"
260+
(goldenCabal "cabal-test-suite-with-comments.golden") $
261+
runGoldenTest (testProjArgs "Y") emptyFlags
262+
263+
, goldenVsString "Test suite, empty flags, not simple, no comments + no minimal"
264+
(goldenCabal "cabal-test-suite-no-comments.golden") $
265+
runGoldenTest (testProjArgs "N") emptyFlags
248266
]
249267
where
250268
runGoldenTest args flags =
@@ -265,6 +283,12 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
265283
testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
266284

267285
mkStanza $ pkgFields ++ [libStanza, testStanza]
286+
287+
(Right (ProjectSettings opts pkgDesc Nothing Nothing (Just testTarget), _)) -> do
288+
let pkgFields = mkPkgDescription opts pkgDesc
289+
testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
290+
291+
mkStanza $ pkgFields ++ [testStanza]
268292

269293
(Right (ProjectSettings _ _ l e t, _)) -> assertFailure $
270294
show l ++ "\n" ++ show e ++ "\n" ++ show t
@@ -319,6 +343,12 @@ pkgArgs = fromList
319343
, "4"
320344
]
321345

346+
testProjArgs :: String -> NonEmpty String
347+
testProjArgs comments = fromList ["4", "foo-package"]
348+
<> pkgArgs
349+
<> fromList (NEL.drop 1 testArgs)
350+
<> fromList [comments]
351+
322352
libProjArgs :: String -> NonEmpty String
323353
libProjArgs comments = fromList ["1", "foo-package"]
324354
<> pkgArgs

‎cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs

Lines changed: 80 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -164,6 +164,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
164164
-- language
165165
, "2"
166166
-- test target
167+
, "y"
167168
-- main file
168169
, "1"
169170
-- test dir
@@ -174,7 +175,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
174175
, "y"
175176
]
176177

177-
case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
178+
case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
178179
Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
179180
_optOverwrite opts @?= False
180181
_optMinimal opts @?= False
@@ -258,6 +259,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
258259
-- language
259260
, "2"
260261
-- test target
262+
, "y"
261263
-- main file
262264
, "1"
263265
-- test dir
@@ -268,7 +270,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
268270
, "y"
269271
]
270272

271-
case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
273+
case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
272274
Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
273275
_optOverwrite opts @?= False
274276
_optMinimal opts @?= False
@@ -311,6 +313,79 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
311313
exe @?= Nothing
312314
test @?! Nothing
313315
Left e -> assertFailure $ show e
316+
317+
, testCase "Check the interactive library workflow" $ do
318+
let inputs = fromList
319+
-- package type
320+
[ "4"
321+
-- package dir
322+
, "test-package"
323+
-- package description
324+
-- cabal version
325+
, "4"
326+
-- package name
327+
, "test-package"
328+
, "test-package"
329+
-- version
330+
, "3.1.2.3"
331+
-- license
332+
, "3"
333+
-- author
334+
, "Foobar"
335+
-- email
336+
, "[email protected]"
337+
-- homepage
338+
, "qux.com"
339+
-- synopsis
340+
, "Qux's package"
341+
-- category
342+
, "3"
343+
-- test target
344+
-- main file
345+
, "1"
346+
-- test dir
347+
, "test"
348+
-- language
349+
, "1"
350+
-- comments
351+
, "y"
352+
]
353+
354+
case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
355+
Right (ProjectSettings opts desc Nothing Nothing (Just test), _) -> do
356+
_optOverwrite opts @?= False
357+
_optMinimal opts @?= False
358+
_optNoComments opts @?= False
359+
_optVerbosity opts @?= silent
360+
_optPkgDir opts @?= "/home/test/test-package"
361+
_optPkgType opts @?= TestSuite
362+
_optPkgName opts @?= mkPackageName "test-package"
363+
364+
_pkgCabalVersion desc @?= CabalSpecV2_4
365+
_pkgName desc @?= mkPackageName "test-package"
366+
_pkgVersion desc @?= mkVersion [3,1,2,3]
367+
_pkgLicense desc @?! SPDX.NONE
368+
_pkgAuthor desc @?= "Foobar"
369+
_pkgEmail desc @?= "[email protected]"
370+
_pkgHomePage desc @?= "qux.com"
371+
_pkgSynopsis desc @?= "Qux's package"
372+
_pkgCategory desc @?= "Control"
373+
_pkgExtraSrcFiles desc @?= mempty
374+
_pkgExtraDocFiles desc @?= pure (Set.singleton "CHANGELOG.md")
375+
376+
_testMainIs test @?= HsFilePath "Main.hs" Standard
377+
_testDirs test @?= ["test"]
378+
_testLanguage test @?= Haskell2010
379+
_testOtherModules test @?= []
380+
_testOtherExts test @?= []
381+
_testDependencies test @?! []
382+
_testBuildTools test @?= []
383+
384+
Right (ProjectSettings _ _ lib exe test, _) -> do
385+
lib @?= Nothing
386+
exe @?= Nothing
387+
test @?! Nothing
388+
Left e -> assertFailure $ show e
314389
]
315390
, testGroup "without tests"
316391
[ testCase "Check the interactive library and executable workflow" $ do
@@ -668,13 +743,13 @@ fileCreatorTests pkgIx srcDb _pkgName = testGroup "generators"
668743
, testGroup "genTestTarget"
669744
[ testCase "Check test package flags workflow" $ do
670745
let inputs = fromList
671-
[ "1" -- pick the first main file option in the list
746+
[ "y" -- say yes to tests
747+
, "1" -- pick the first main file option in the list
672748
, "test" -- package test dir
673749
, "1" -- pick the first language in the list
674750
]
675751

676-
runGenTest inputs $ genTestTarget
677-
(emptyFlags {initializeTestSuite = Flag True}) pkgIx
752+
runGenTest inputs $ genTestTarget emptyFlags pkgIx
678753
]
679754
]
680755
where

0 commit comments

Comments
 (0)