Unverified Commit 92283614 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #7110 from phadej/nothunks

Add nothunks test for parser
parents 8c2e3f6b 82009a5a
......@@ -29,14 +29,7 @@ import Distribution.Simple.Setup (HaddockTarget, TestShowDetai
import Distribution.System
import Distribution.Types.AbiHash (AbiHash)
import Distribution.Types.ComponentId (ComponentId)
import Distribution.Types.IncludeRenaming (IncludeRenaming)
import Distribution.Types.Mixin
import Distribution.Types.ModuleReexport
import Distribution.Types.ModuleRenaming
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.PkgconfigName (PkgconfigName)
import Distribution.Types.PkgconfigVersion (PkgconfigVersion)
import Distribution.Types.PkgconfigVersionRange (PkgconfigVersionRange)
import Distribution.Types.UnitId (DefUnitId, UnitId)
import Distribution.Utils.NubList (NubList)
import Distribution.Utils.ShortText (ShortText, fromShortText)
......
......@@ -848,3 +848,21 @@ test-suite rpmvercmp
ghc-options: -Wall
default-language: Haskell2010
test-suite no-thunks-test
default-language: Haskell2010
ghc-options: -Wall
type: exitcode-stdio-1.0
main-is: NoThunks.hs
if !impl(ghc >= 8.6)
buildable: False
hs-source-dirs: tests
build-depends:
base,
Cabal,
tasty >= 1.2.3 && < 1.4,
bytestring,
tasty-hunit,
nothunks
......@@ -57,10 +57,8 @@ import Distribution.ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Types.IncludeRenaming
import Distribution.Types.ComponentInclude
import Distribution.Types.AnnotatedId
import Distribution.Types.ModuleRenaming
import Distribution.Verbosity
import Data.STRef
......
......@@ -46,6 +46,10 @@ module Distribution.PackageDescription (
module Distribution.Types.PackageId,
module Distribution.Types.PackageName,
module Distribution.Types.UnqualComponentName,
-- * Pkgconfig
module Distribution.Types.PkgconfigName,
module Distribution.Types.PkgconfigVersion,
module Distribution.Types.PkgconfigVersionRange,
-- * Dependencies
module Distribution.Types.Dependency,
module Distribution.Types.ExeDependency,
......@@ -55,6 +59,11 @@ module Distribution.PackageDescription (
module Distribution.Types.CondTree,
module Distribution.Types.Condition,
module Distribution.Types.ConfVar,
-- * Mixin
module Distribution.Types.IncludeRenaming,
module Distribution.Types.Mixin,
module Distribution.Types.ModuleReexport,
module Distribution.Types.ModuleRenaming,
-- * Source repository
module Distribution.Types.SourceRepo,
) where
......@@ -81,14 +90,21 @@ import Distribution.Types.ForeignLibOption
import Distribution.Types.ForeignLibType
import Distribution.Types.GenericPackageDescription
import Distribution.Types.HookedBuildInfo
import Distribution.Types.IncludeRenaming
import Distribution.Types.LegacyExeDependency
import Distribution.Types.Library
import Distribution.Types.LibraryName
import Distribution.Types.LibraryVisibility
import Distribution.Types.Mixin
import Distribution.Types.ModuleReexport
import Distribution.Types.ModuleRenaming
import Distribution.Types.PackageDescription
import Distribution.Types.PackageId
import Distribution.Types.PackageName
import Distribution.Types.PkgconfigDependency
import Distribution.Types.PkgconfigName
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.SetupBuildInfo
import Distribution.Types.SourceRepo
import Distribution.Types.TestSuite
......
......@@ -52,7 +52,6 @@ import Distribution.Simple.Glob
import Distribution.Simple.Utils hiding (findPackageDesc, notice)
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ModuleReexport
import Distribution.Utils.Generic (isAscii)
import Distribution.Verbosity
import Distribution.Version
......
......@@ -57,18 +57,16 @@ import Language.Haskell.Extension
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compat.Newtype (Newtype)
import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.Compat.Newtype (Newtype)
import Distribution.Compiler (CompilerFlavor (..), PerCompilerFlavor (..))
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.ModuleName (ModuleName)
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Parsec
import Distribution.Pretty (Pretty (..), prettyShow, showToken)
import Distribution.Types.Mixin (Mixin)
import Distribution.Types.ModuleReexport
import Distribution.Version (Version, VersionRange)
import Distribution.Pretty (Pretty (..), prettyShow, showToken)
import Distribution.Version (Version, VersionRange)
import qualified Data.ByteString.Char8 as BS8
import qualified Distribution.SPDX as SPDX
......
......@@ -56,7 +56,6 @@ import Distribution.Parsec.Position (Position (..), zeroPos)
import Distribution.Parsec.Warning (PWarnType (..))
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS)
import Distribution.Types.Mixin (Mixin (..), mkMixin)
import Distribution.Utils.Generic (breakMaybe, unfoldrM, validateUTF8)
import Distribution.Verbosity (Verbosity)
import Distribution.Version (Version, mkVersion, versionNumbers)
......@@ -208,6 +207,12 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do
let gpd2 = postProcessInternalDeps specVer gpd1
checkForUndefinedFlags gpd2
checkForUndefinedCustomSetup gpd2
-- See nothunks test, without this deepseq we get (at least):
-- Thunk in ThunkInfo {thunkContext = ["PackageIdentifier","PackageDescription","GenericPackageDescription"]}
--
-- TODO: re-benchmark, whether `deepseq` is important (both cabal-benchmarks and solver-benchmarks)
-- TODO: remove the need for deepseq if `deepseq` in fact matters
-- NOTE: IIRC it does affect (maximal) memory usage, which causes less GC pressure
gpd2 `deepseq` return gpd2
where
safeLast :: [a] -> Maybe a
......
......@@ -37,7 +37,6 @@ import Distribution.Compat.Lens
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Utils (writeFileAtomic, writeUTF8File)
import Distribution.Types.Mixin (Mixin (..), mkMixin)
import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar)
import Distribution.PackageDescription.Configuration (transformAllBuildInfos)
import Distribution.PackageDescription.FieldGrammar
......
......@@ -77,12 +77,9 @@ import Distribution.Simple.Setup as Setup
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.LocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.GivenComponent
import Distribution.Types.Mixin
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
......
......@@ -63,7 +63,6 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Types.UnitId
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Types.ModuleRenaming
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.System
......
......@@ -36,7 +36,6 @@ import Distribution.Simple.Program.Run
import Distribution.System
import Distribution.Pretty
import Distribution.Types.ComponentId
import Distribution.Types.ModuleRenaming
import Distribution.Verbosity
import Distribution.Version
import Distribution.Utils.NubList
......
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main (main) where
import Control.Applicative ((<|>))
import Data.Foldable (toList)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable, typeRep)
import Distribution.CabalSpecVersion (CabalSpecVersion)
import Distribution.Compat.NonEmptySet (NonEmptySet)
import Distribution.Compiler (CompilerFlavor, PerCompilerFlavor)
import Distribution.Fields (runParseResult)
import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
import Distribution.SPDX (License, LicenseExceptionId, LicenseExpression, LicenseId, LicenseRef, SimpleLicenseExpression)
import Distribution.System (Arch, OS)
import Distribution.Utils.ShortText (ShortText)
import Distribution.Version (Version, VersionRange)
import Language.Haskell.Extension (Extension, KnownExtension, Language)
import NoThunks.Class (NoThunks (..), OnlyCheckWhnf (..), noThunksInValues)
import Test.Tasty (defaultMain, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase)
import Distribution.PackageDescription
import qualified Data.ByteString as BS
import qualified Distribution.License as License
main :: IO ()
main = defaultMain $ testGroup "nothunks"
[ testCase "parsing Cabal.cabal" noThunksParse
]
noThunksParse :: IO ()
noThunksParse = do
bs <- BS.readFile "Cabal/Cabal.cabal" <|> BS.readFile "Cabal.cabal"
let res = parseGenericPackageDescription bs
gpd <- either (assertFailure . show) return $ snd $
runParseResult res
noThunks [] gpd >>= \case
-- ok
Nothing -> return ()
-- found thunk
Just info -> assertFailure $ "Thunk in " ++ show info
-------------------------------------------------------------------------------
-- NoThunks instances
-------------------------------------------------------------------------------
instance NoThunks Arch
instance NoThunks Benchmark
instance NoThunks BenchmarkInterface
instance NoThunks BenchmarkType
instance NoThunks BuildInfo
instance NoThunks BuildType
instance NoThunks CabalSpecVersion
instance NoThunks CompilerFlavor
instance NoThunks ConfVar
instance NoThunks Dependency
instance NoThunks Executable
instance NoThunks ExecutableScope
instance NoThunks FlagName
instance NoThunks ForeignLib
instance NoThunks ForeignLibOption
instance NoThunks ModuleReexport
instance NoThunks LibraryVisibility
instance NoThunks ForeignLibType
instance NoThunks GenericPackageDescription
instance NoThunks KnownRepoType
instance NoThunks Library
instance NoThunks LibraryName
instance NoThunks Mixin
instance NoThunks License
instance NoThunks License.License
instance NoThunks LicenseExpression
instance NoThunks LicenseRef
instance NoThunks ModuleName
instance NoThunks OS
instance NoThunks PackageDescription
instance NoThunks PackageFlag
instance NoThunks PackageIdentifier
instance NoThunks PackageName
instance NoThunks LegacyExeDependency
instance NoThunks ExeDependency
instance NoThunks PkgconfigName
instance NoThunks PkgconfigDependency
instance NoThunks PkgconfigVersion
instance NoThunks PkgconfigVersionRange
instance NoThunks LibVersionInfo
instance NoThunks RepoKind
instance NoThunks RepoType
instance NoThunks Extension
instance NoThunks Language
instance NoThunks SetupBuildInfo
instance NoThunks SimpleLicenseExpression
instance NoThunks KnownExtension
instance NoThunks SourceRepo
instance NoThunks IncludeRenaming
instance NoThunks ModuleRenaming
instance NoThunks TestSuite
instance NoThunks TestSuiteInterface
instance NoThunks TestType
instance NoThunks UnqualComponentName
instance NoThunks Version
instance NoThunks VersionRange
instance NoThunks ShortText where
instance NoThunks a => NoThunks (PerCompilerFlavor a)
deriving via (OnlyCheckWhnf LicenseId) instance NoThunks LicenseId
deriving via (OnlyCheckWhnf LicenseExceptionId) instance NoThunks LicenseExceptionId
deriving via (CheckFoldableNamed NonEmptySet a) instance NoThunks a => NoThunks (NonEmptySet a)
instance (NoThunks v, NoThunks c, NoThunks a) => NoThunks (CondTree v c a)
instance (NoThunks v, NoThunks c, NoThunks a) => NoThunks (CondBranch v c a)
instance (NoThunks c) => NoThunks (Condition c)
-------------------------------------------------------------------------------
-- NoThunks helpers
-------------------------------------------------------------------------------
newtype CheckFoldableNamed f a = CheckFoldableNamed (f a)
instance (NoThunks a, Foldable f, Typeable f) => NoThunks (CheckFoldableNamed f a) where
showTypeOf _ = show (typeRep (Proxy :: Proxy f))
wNoThunks ctxt (CheckFoldableNamed xs) = noThunksInValues ctxt (toList xs)
......@@ -26,7 +26,6 @@ import Distribution.ModuleName (ModuleName)
import Distribution.License (License)
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.PackageDescription as Source
import qualified Distribution.Types.ModuleReexport as Source
import Distribution.PackageDescription
( PackageFlag(..), unFlagName )
import Distribution.PackageDescription.Configuration
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment