Skip to content

Commit 47d899f

Browse files
gbazandreabedini
authored andcommitted
code-generators field in test stanza. (haskell#7688)
* wip to add test-code-generators field to test stanzas * fixups * change hashes * regen golden parser test output * docs and changelog * test * Update pr-7688 * tweak test Co-authored-by: Gershom Bazerman <[email protected]>
1 parent 309103d commit 47d899f

File tree

30 files changed

+7090
-6942
lines changed

30 files changed

+7090
-6942
lines changed

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

Lines changed: 25 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -268,6 +268,7 @@ data TestSuiteStanza = TestSuiteStanza
268268
, _testStanzaMainIs :: Maybe FilePath
269269
, _testStanzaTestModule :: Maybe ModuleName
270270
, _testStanzaBuildInfo :: BuildInfo
271+
, _testStanzaCodeGenerators :: [String]
271272
}
272273

273274
instance L.HasBuildInfo TestSuiteStanza where
@@ -289,13 +290,18 @@ testStanzaBuildInfo :: Lens' TestSuiteStanza BuildInfo
289290
testStanzaBuildInfo f s = fmap (\x -> s { _testStanzaBuildInfo = x }) (f (_testStanzaBuildInfo s))
290291
{-# INLINE testStanzaBuildInfo #-}
291292

293+
testStanzaCodeGenerators :: Lens' TestSuiteStanza [String]
294+
testStanzaCodeGenerators f s = fmap (\x -> s { _testStanzaCodeGenerators = x }) (f (_testStanzaCodeGenerators s))
295+
{-# INLINE testStanzaCodeGenerators #-}
296+
292297
testSuiteFieldGrammar
293298
:: ( FieldGrammar c g, Applicative (g TestSuiteStanza), Applicative (g BuildInfo)
294299
, c (Identity ModuleName)
295300
, c (Identity TestType)
296301
, c (List CommaFSep (Identity ExeDependency) ExeDependency)
297302
, c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
298303
, c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
304+
, c (List CommaFSep Token String)
299305
, c (List CommaVCat (Identity Dependency) Dependency)
300306
, c (List CommaVCat (Identity Mixin) Mixin)
301307
, c (List FSep (MQuoted Extension) Extension)
@@ -315,23 +321,20 @@ testSuiteFieldGrammar = TestSuiteStanza
315321
<*> optionalFieldAla "main-is" FilePathNT testStanzaMainIs
316322
<*> optionalField "test-module" testStanzaTestModule
317323
<*> blurFieldGrammar testStanzaBuildInfo buildInfoFieldGrammar
324+
<*> monoidalFieldAla "code-generators" (alaList' CommaFSep Token) testStanzaCodeGenerators
325+
^^^ availableSince CabalSpecV3_6 [] -- TODO 3_8
318326

319327
validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite
320328
validateTestSuite pos stanza = case _testStanzaTestType stanza of
321-
Nothing -> return $
322-
emptyTestSuite { testBuildInfo = _testStanzaBuildInfo stanza }
329+
Nothing -> pure basicTestSuite
323330

324331
Just tt@(TestTypeUnknown _ _) ->
325-
pure emptyTestSuite
326-
{ testInterface = TestSuiteUnsupported tt
327-
, testBuildInfo = _testStanzaBuildInfo stanza
328-
}
332+
pure basicTestSuite
333+
{ testInterface = TestSuiteUnsupported tt }
329334

330335
Just tt | tt `notElem` knownTestTypes ->
331-
pure emptyTestSuite
332-
{ testInterface = TestSuiteUnsupported tt
333-
, testBuildInfo = _testStanzaBuildInfo stanza
334-
}
336+
pure basicTestSuite
337+
{ testInterface = TestSuiteUnsupported tt }
335338

336339
Just tt@(TestTypeExe ver) -> case _testStanzaMainIs stanza of
337340
Nothing -> do
@@ -340,36 +343,38 @@ validateTestSuite pos stanza = case _testStanzaTestType stanza of
340343
Just file -> do
341344
when (isJust (_testStanzaTestModule stanza)) $
342345
parseWarning pos PWTExtraBenchmarkModule (extraField "test-module" tt)
343-
pure emptyTestSuite
344-
{ testInterface = TestSuiteExeV10 ver file
345-
, testBuildInfo = _testStanzaBuildInfo stanza
346-
}
346+
pure basicTestSuite
347+
{ testInterface = TestSuiteExeV10 ver file }
347348

348349
Just tt@(TestTypeLib ver) -> case _testStanzaTestModule stanza of
349350
Nothing -> do
350-
parseFailure pos (missingField "test-module" tt)
351-
pure emptyTestSuite
351+
parseFailure pos (missingField "test-module" tt)
352+
pure emptyTestSuite
352353
Just module_ -> do
353354
when (isJust (_testStanzaMainIs stanza)) $
354355
parseWarning pos PWTExtraMainIs (extraField "main-is" tt)
355-
pure emptyTestSuite
356-
{ testInterface = TestSuiteLibV09 ver module_
357-
, testBuildInfo = _testStanzaBuildInfo stanza
358-
}
356+
pure basicTestSuite
357+
{ testInterface = TestSuiteLibV09 ver module_ }
359358

360359
where
361360
missingField name tt = "The '" ++ name ++ "' field is required for the "
362361
++ prettyShow tt ++ " test suite type."
363362

364363
extraField name tt = "The '" ++ name ++ "' field is not used for the '"
365364
++ prettyShow tt ++ "' test suite type."
365+
basicTestSuite =
366+
emptyTestSuite {
367+
testBuildInfo = _testStanzaBuildInfo stanza
368+
, testCodeGenerators = _testStanzaCodeGenerators stanza
369+
}
366370

367371
unvalidateTestSuite :: TestSuite -> TestSuiteStanza
368372
unvalidateTestSuite t = TestSuiteStanza
369373
{ _testStanzaTestType = ty
370374
, _testStanzaMainIs = ma
371375
, _testStanzaTestModule = mo
372376
, _testStanzaBuildInfo = testBuildInfo t
377+
, _testStanzaCodeGenerators = testCodeGenerators t
373378
}
374379
where
375380
(ty, ma, mo) = case testInterface t of

Cabal-syntax/src/Distribution/PackageDescription/Parsec.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -566,7 +566,7 @@ instance FromBuildInfo ForeignLib where fromBuildInfo' n bi = set L.foreignLibNa
566566
instance FromBuildInfo Executable where fromBuildInfo' n bi = set L.exeName n $ set L.buildInfo bi emptyExecutable
567567

568568
instance FromBuildInfo TestSuiteStanza where
569-
fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi
569+
fromBuildInfo' _ bi = TestSuiteStanza Nothing Nothing Nothing bi []
570570

571571
instance FromBuildInfo BenchmarkStanza where
572572
fromBuildInfo' _ bi = BenchmarkStanza Nothing Nothing Nothing bi
@@ -671,7 +671,7 @@ onAllBranches p = go mempty
671671
-- Post parsing checks
672672
-------------------------------------------------------------------------------
673673

674-
-- | Check that we
674+
-- | Check that we
675675
--
676676
-- * don't use undefined flags (very bad)
677677
-- * define flags which are unused (just bad)

Cabal-syntax/src/Distribution/Types/TestSuite.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,8 @@ import qualified Distribution.Types.BuildInfo.Lens as L
2626
data TestSuite = TestSuite {
2727
testName :: UnqualComponentName,
2828
testInterface :: TestSuiteInterface,
29-
testBuildInfo :: BuildInfo
29+
testBuildInfo :: BuildInfo,
30+
testCodeGenerators :: [String]
3031
}
3132
deriving (Generic, Show, Read, Eq, Typeable, Data)
3233

@@ -42,15 +43,17 @@ instance Monoid TestSuite where
4243
mempty = TestSuite {
4344
testName = mempty,
4445
testInterface = mempty,
45-
testBuildInfo = mempty
46+
testBuildInfo = mempty,
47+
testCodeGenerators = mempty
4648
}
4749
mappend = (<>)
4850

4951
instance Semigroup TestSuite where
5052
a <> b = TestSuite {
5153
testName = combine' testName,
5254
testInterface = combine testInterface,
53-
testBuildInfo = combine testBuildInfo
55+
testBuildInfo = combine testBuildInfo,
56+
testCodeGenerators = combine testCodeGenerators
5457
}
5558
where combine field = field a `mappend` field b
5659
combine' field = case ( unUnqualComponentName $ field a

0 commit comments

Comments
 (0)