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

VCS tests: Make smaller Arbitrary repositories to speed up long-tests 4.2x #10588

Merged
merged 1 commit into from
Nov 27, 2024
Merged
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
66 changes: 54 additions & 12 deletions cabal-install/tests/UnitTests/Distribution/Client/VCS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,12 @@ import UnitTests.Distribution.Client.ArbitraryInstances
tests :: MTimeChange -> [TestTree]
tests mtimeChange =
map
-- Are you tuning performance for these tests? The size of the arbitrary
-- instances involved is very significant, because each element generated
-- corresponds to one or more Git subcommands being run.
--
-- See [Tuning Arbitrary Instances] below for more information and
-- parameters.
(localOption $ QuickCheckTests 10)
[ ignoreInWindows "See issue #8048 and #9519" $
testGroup
Expand Down Expand Up @@ -472,6 +478,7 @@ instance Arbitrary PrngSeed where
-- VCS commands to make a repository on-disk.

data SubmodulesSupport = SubmodulesSupported | SubmodulesNotSupported
deriving (Show, Eq)

class KnownSubmodulesSupport (a :: SubmodulesSupport) where
submoduleSupport :: SubmodulesSupport
Expand All @@ -484,7 +491,11 @@ instance KnownSubmodulesSupport 'SubmodulesNotSupported where

data FileUpdate = FileUpdate FilePath String
deriving (Show)
data SubmoduleAdd = SubmoduleAdd FilePath FilePath (Commit 'SubmodulesSupported)
data SubmoduleAdd = SubmoduleAdd
{ submodulePath :: FilePath
, submoduleSource :: FilePath
, submoduleCommit :: Commit 'SubmodulesSupported
}
deriving (Show)

newtype Commit (submodules :: SubmodulesSupport)
Expand Down Expand Up @@ -525,40 +536,71 @@ data RepoRecipe submodules
genFileName :: Gen FilePath
genFileName = (\c -> "file" </> [c]) <$> choose ('A', 'E')

-- [Tuning Arbitrary Instances]
--
-- Arbitrary repo recipes can get quite large due to nesting:
--
-- - `RepoRecipes` contain a number of groups (`TaggedCommits` or `BranchCommits`).
-- - Groups contain a number of `Commit`s.
-- - Commits contain a number of operations (`FileUpdate` or `SubmoduleAdd`).
--
-- There's also another wrinkle in that `SubmoduleAdd`s contain a `Commit`
-- themselves, so square the `operationsPerCommit` number!
--
-- Then, a rough upper bound of the number of `git` calls required for an
-- arbitrary `RepoRecipe` is
-- `groupsPerRecipe * commitsPerGroup * operationsPerCommit^2`.
--
-- The original implementation of these instances, which chose
-- reasonable-sounding size parameters of 5-15, led to a maximum of 1875
-- operations per test case! No wonder they took so long!
--
-- In most cases, we only care about one or many operations, so "two" is a fine
-- stand-in for "many" :)
groupsPerRecipe :: Int
groupsPerRecipe = 3

commitsPerGroup :: Int
commitsPerGroup = 3

operationsPerCommit :: Int
operationsPerCommit = 3

instance Arbitrary FileUpdate where
arbitrary = genOnlyFileUpdate
arbitrary = FileUpdate <$> genFileName <*> genFileContent
where
genOnlyFileUpdate = FileUpdate <$> genFileName <*> genFileContent
genFileContent = vectorOf 10 (choose ('#', '~'))

instance Arbitrary SubmoduleAdd where
arbitrary = genOnlySubmoduleAdd
arbitrary = SubmoduleAdd <$> genFileName <*> genSubmoduleSrc <*> arbitrary
where
genOnlySubmoduleAdd = SubmoduleAdd <$> genFileName <*> genSubmoduleSrc <*> arbitrary
genSubmoduleSrc = vectorOf 20 (choose ('a', 'z'))

instance forall submodules. KnownSubmodulesSupport submodules => Arbitrary (Commit submodules) where
arbitrary = Commit <$> shortListOf1 5 fileUpdateOrSubmoduleAdd
arbitrary = Commit <$> shortListOf1 operationsPerCommit (sized fileUpdateOrSubmoduleAdd)
where
fileUpdateOrSubmoduleAdd =
fileUpdateOrSubmoduleAdd 0 = Left <$> arbitrary
fileUpdateOrSubmoduleAdd size =
case submoduleSupport @submodules of
SubmodulesSupported ->
frequency
[ (10, Left <$> arbitrary)
, (1, Right <$> arbitrary)
, -- A `SubmoduleAdd` contains a `Commit`, so we make sure to scale
-- down the size in the recursive call to avoid unbounded nesting.
(1, Right <$> resize (size `div` 2) arbitrary)
]
SubmodulesNotSupported -> Left <$> arbitrary
shrink (Commit writes) = Commit <$> filter (not . null) (shrink writes)

instance KnownSubmodulesSupport submodules => Arbitrary (TaggedCommits submodules) where
arbitrary = TaggedCommits <$> genTagName <*> shortListOf1 5 arbitrary
arbitrary = TaggedCommits <$> genTagName <*> shortListOf1 commitsPerGroup arbitrary
where
genTagName = ("tag_" ++) <$> shortListOf1 5 (choose ('A', 'Z'))
shrink (TaggedCommits tag commits) =
TaggedCommits tag <$> filter (not . null) (shrink commits)

instance KnownSubmodulesSupport submodules => Arbitrary (BranchCommits submodules) where
arbitrary = BranchCommits <$> genBranchName <*> shortListOf1 5 arbitrary
arbitrary = BranchCommits <$> genBranchName <*> shortListOf1 commitsPerGroup arbitrary
where
genBranchName =
sized $ \n ->
Expand All @@ -568,12 +610,12 @@ instance KnownSubmodulesSupport submodules => Arbitrary (BranchCommits submodule
BranchCommits branch <$> filter (not . null) (shrink commits)

instance KnownSubmodulesSupport submodules => Arbitrary (NonBranchingRepoRecipe submodules) where
arbitrary = NonBranchingRepoRecipe <$> shortListOf1 15 arbitrary
arbitrary = NonBranchingRepoRecipe <$> shortListOf1 groupsPerRecipe arbitrary
shrink (NonBranchingRepoRecipe xs) =
NonBranchingRepoRecipe <$> filter (not . null) (shrink xs)

instance KnownSubmodulesSupport submodules => Arbitrary (BranchingRepoRecipe submodules) where
arbitrary = BranchingRepoRecipe <$> shortListOf1 15 taggedOrBranch
arbitrary = BranchingRepoRecipe <$> shortListOf1 groupsPerRecipe taggedOrBranch
where
taggedOrBranch =
frequency
Expand Down
Loading