Skip to content

Commit 5162f1f

Browse files
erikderikd
committed
Add tests for active-repositories feature
These tests were generated by Claude code, but manually reviewed.
1 parent cc98704 commit 5162f1f

4 files changed

Lines changed: 278 additions & 2 deletions

File tree

‎cabal-install/cabal-install.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -341,6 +341,7 @@ test-suite unit-tests
341341
UnitTests.Distribution.Client.Glob
342342
UnitTests.Distribution.Client.GZipUtils
343343
UnitTests.Distribution.Client.IndexUtils
344+
UnitTests.Distribution.Client.IndexUtils.ActiveRepos
344345
UnitTests.Distribution.Client.IndexUtils.Timestamp
345346
UnitTests.Distribution.Client.Init
346347
UnitTests.Distribution.Client.Init.Golden

‎cabal-install/tests/UnitTests.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ import qualified UnitTests.Distribution.Client.GZipUtils
99
import qualified UnitTests.Distribution.Client.Get
1010
import qualified UnitTests.Distribution.Client.Glob
1111
import qualified UnitTests.Distribution.Client.IndexUtils
12+
import qualified UnitTests.Distribution.Client.IndexUtils.ActiveRepos
1213
import qualified UnitTests.Distribution.Client.IndexUtils.Timestamp
1314
import qualified UnitTests.Distribution.Client.Init
1415
import qualified UnitTests.Distribution.Client.InstallPlan
@@ -52,6 +53,9 @@ main = do
5253
, testGroup
5354
"UnitTests.Distribution.Client.IndexUtils"
5455
UnitTests.Distribution.Client.IndexUtils.tests
56+
, testGroup
57+
"UnitTests.Distribution.Client.IndexUtils.ActiveRepos"
58+
UnitTests.Distribution.Client.IndexUtils.ActiveRepos.tests
5559
, testGroup
5660
"UnitTests.Distribution.Client.IndexUtils.Timestamp"
5761
UnitTests.Distribution.Client.IndexUtils.Timestamp.tests

‎cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs‎

Lines changed: 122 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,29 @@
11
module UnitTests.Distribution.Client.IndexUtils where
22

33
import Distribution.Client.IndexUtils
4+
import Distribution.Client.IndexUtils.ActiveRepos
45
import qualified Distribution.Compat.NonEmptySet as NES
6+
import Distribution.Package
57
import Distribution.Simple.Utils (toUTF8LBS)
6-
import Distribution.Types.Dependency
78
import Distribution.Types.LibraryName
8-
import Distribution.Types.PackageName
99
import Distribution.Version
10+
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
11+
12+
import Data.List (sort)
1013

1114
import Test.Tasty
1215
import Test.Tasty.HUnit
1316

1417
tests :: [TestTree]
1518
tests =
1619
[ simpleVersionsParserTests
20+
, indexCombiningTests
1721
]
1822

23+
-- ---------------------------------------------------------------------------
24+
-- Preferred-versions parser tests
25+
-- ---------------------------------------------------------------------------
26+
1927
simpleVersionsParserTests :: TestTree
2028
simpleVersionsParserTests =
2129
testGroup
@@ -80,3 +88,115 @@ simpleVersionsParserTests =
8088
]
8189
, preferredVersionsOriginalDependency = "binary 0.9.0.0 || > 0.9.0.0"
8290
}
91+
92+
-- ---------------------------------------------------------------------------
93+
-- Index-combining tests
94+
--
95+
-- These test the addIndex / foldl' logic inside getSourcePackagesAtIndexState,
96+
-- which applies CombineStrategy to a sequence of PackageIndex values:
97+
--
98+
-- addIndex acc (_, Skip) = acc
99+
-- addIndex acc (idx, Merge) = PackageIndex.merge acc idx
100+
-- addIndex acc (idx, Override) = PackageIndex.override acc idx
101+
-- pkgs = foldl' addIndex mempty pkgss'
102+
-- ---------------------------------------------------------------------------
103+
104+
indexCombiningTests :: TestTree
105+
indexCombiningTests =
106+
testGroup
107+
"Index combining (CombineStrategy)"
108+
[ testCase "Skip: repo contributes nothing" $
109+
pkgs [(repoFoo1, CombineStrategySkip)]
110+
@?= []
111+
, testCase "Merge: single repo makes all its packages visible" $
112+
pkgs [(repoFoo1, CombineStrategyMerge)]
113+
@?= [foo1]
114+
, testCase "Override: single repo makes all its packages visible" $
115+
pkgs [(repoFoo1, CombineStrategyOverride)]
116+
@?= [foo1]
117+
, testCase "Merge+Merge: non-overlapping packages are both visible" $
118+
pkgs [(repoFoo1, CombineStrategyMerge), (repoBar1, CombineStrategyMerge)]
119+
@?= sort [foo1, bar1]
120+
, testCase "Merge+Merge: different versions of same package are both visible" $
121+
pkgs [(repoFoo1, CombineStrategyMerge), (repoFoo2, CombineStrategyMerge)]
122+
@?= sort [foo1, foo2]
123+
, testCase "Merge+Override: packages only in first repo remain visible" $
124+
pkgs [(repoFoo1, CombineStrategyMerge), (repoBar1, CombineStrategyOverride)]
125+
@?= sort [foo1, bar1]
126+
, testCase "Merge+Override: override repo replaces all versions of overlapping package" $
127+
-- repoFoo12 has foo-1.0 and foo-1.1; repoFoo2 has only foo-2.0.
128+
-- Override means repoFoo2 wins the entire 'foo' bucket.
129+
pkgs [(repoFoo12, CombineStrategyMerge), (repoFoo2, CombineStrategyOverride)]
130+
@?= [foo2]
131+
, testCase "Merge+Override: override does not affect packages absent from override repo" $
132+
pkgs [(repoFoo1bar1, CombineStrategyMerge), (repoFoo2, CombineStrategyOverride)]
133+
@?= sort [foo2, bar1]
134+
, testCase "Skip in middle: skipped repo is ignored" $
135+
pkgs
136+
[ (repoFoo1, CombineStrategyMerge)
137+
, (repoFoo2, CombineStrategySkip)
138+
, (repoBar1, CombineStrategyMerge)
139+
]
140+
@?= sort [foo1, bar1]
141+
, testCase "Skip+Merge: later merge after skip still contributes" $
142+
pkgs [(repoFoo1, CombineStrategySkip), (repoFoo2, CombineStrategyMerge)]
143+
@?= [foo2]
144+
, testCase "Override+Override: last override wins the package bucket" $
145+
pkgs
146+
[ (repoFoo1, CombineStrategyMerge)
147+
, (repoFoo2, CombineStrategyOverride)
148+
, (repoFoo3, CombineStrategyOverride)
149+
]
150+
@?= [foo3]
151+
, testCase "Override+Merge: merge after override combines both buckets" $
152+
-- foo bucket starts as {foo-2.0} after override, then merges {foo-3.0}
153+
-- giving {foo-2.0, foo-3.0}
154+
pkgs
155+
[ (repoFoo1, CombineStrategyMerge)
156+
, (repoFoo2, CombineStrategyOverride)
157+
, (repoFoo3, CombineStrategyMerge)
158+
]
159+
@?= sort [foo2, foo3]
160+
, testCase "All skip: result is empty" $
161+
pkgs
162+
[ (repoFoo1, CombineStrategySkip)
163+
, (repoFoo2, CombineStrategySkip)
164+
]
165+
@?= []
166+
, testCase "Empty repos list: result is empty" $
167+
pkgs [] @?= []
168+
]
169+
170+
-- Mirrors the addIndex / foldl' in getSourcePackagesAtIndexState.
171+
combineIndex
172+
:: PackageIndex.PackageIndex PackageIdentifier
173+
-> (PackageIndex.PackageIndex PackageIdentifier, CombineStrategy)
174+
-> PackageIndex.PackageIndex PackageIdentifier
175+
combineIndex acc (_, CombineStrategySkip) = acc
176+
combineIndex acc (idx, CombineStrategyMerge) = PackageIndex.merge acc idx
177+
combineIndex acc (idx, CombineStrategyOverride) = PackageIndex.override acc idx
178+
179+
-- Run the combining fold and return the result as a sorted list of PackageIds.
180+
pkgs
181+
:: [(PackageIndex.PackageIndex PackageIdentifier, CombineStrategy)]
182+
-> [PackageIdentifier]
183+
pkgs = sort . PackageIndex.allPackages . foldl combineIndex mempty
184+
185+
-- Test packages
186+
foo1, foo2, foo3, bar1 :: PackageIdentifier
187+
foo1 = PackageIdentifier (mkPackageName "foo") (mkVersion [1, 0])
188+
foo2 = PackageIdentifier (mkPackageName "foo") (mkVersion [2, 0])
189+
foo3 = PackageIdentifier (mkPackageName "foo") (mkVersion [3, 0])
190+
bar1 = PackageIdentifier (mkPackageName "bar") (mkVersion [1, 0])
191+
192+
-- Single-package indices
193+
repoFoo1, repoFoo2, repoFoo3, repoBar1 :: PackageIndex.PackageIndex PackageIdentifier
194+
repoFoo1 = PackageIndex.fromList [foo1]
195+
repoFoo2 = PackageIndex.fromList [foo2]
196+
repoFoo3 = PackageIndex.fromList [foo3]
197+
repoBar1 = PackageIndex.fromList [bar1]
198+
199+
-- Multi-package indices
200+
repoFoo12, repoFoo1bar1 :: PackageIndex.PackageIndex PackageIdentifier
201+
repoFoo12 = PackageIndex.fromList [foo1, foo2]
202+
repoFoo1bar1 = PackageIndex.fromList [foo1, bar1]

‎cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/ActiveRepos.hs‎

Lines changed: 151 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
module UnitTests.Distribution.Client.IndexUtils.ActiveRepos (tests) where
2+
3+
import Distribution.Client.IndexUtils.ActiveRepos
4+
import Distribution.Client.Types.RepoName (RepoName (..))
5+
import Distribution.Parsec (simpleParsec)
6+
import Distribution.Pretty (prettyShow)
7+
8+
import UnitTests.Distribution.Client.ArbitraryInstances ()
9+
10+
import Test.Tasty
11+
import Test.Tasty.HUnit
12+
import Test.Tasty.QuickCheck
13+
14+
tests :: [TestTree]
15+
tests =
16+
[ testGroup "organizeByRepos" organizeByReposTests
17+
, testGroup "filterSkippedActiveRepos" filterSkippedTests
18+
, testGroup "parse/pretty roundtrip"
19+
[ testProperty "ActiveRepos roundtrips" prop_activeReposRoundtrip
20+
]
21+
]
22+
23+
-------------------------------------------------------------------------------
24+
-- organizeByRepos
25+
-------------------------------------------------------------------------------
26+
27+
-- Convenience: run organizeByRepos over a fixed three-element repo list.
28+
organize :: ActiveRepos -> Either String [(RepoName, CombineStrategy)]
29+
organize ar = organizeByRepos ar id [RepoName "a", RepoName "b", RepoName "c"]
30+
31+
organizeByReposTests :: [TestTree]
32+
organizeByReposTests =
33+
[ testCase ":rest assigns strategy to all repos in order" $
34+
organize (ActiveRepos [ActiveRepoRest CombineStrategyMerge])
35+
@?= Right
36+
[ (RepoName "a", CombineStrategyMerge)
37+
, (RepoName "b", CombineStrategyMerge)
38+
, (RepoName "c", CombineStrategyMerge)
39+
]
40+
, testCase ":none yields empty result" $
41+
organize (ActiveRepos [])
42+
@?= Right []
43+
, testCase "named repo before :rest is placed first" $
44+
organize
45+
( ActiveRepos
46+
[ ActiveRepo (RepoName "b") CombineStrategyOverride
47+
, ActiveRepoRest CombineStrategyMerge
48+
]
49+
)
50+
@?= Right
51+
[ (RepoName "b", CombineStrategyOverride)
52+
, (RepoName "a", CombineStrategyMerge)
53+
, (RepoName "c", CombineStrategyMerge)
54+
]
55+
, testCase "named repo after :rest is placed last" $
56+
organize
57+
( ActiveRepos
58+
[ ActiveRepoRest CombineStrategyMerge
59+
, ActiveRepo (RepoName "b") CombineStrategyOverride
60+
]
61+
)
62+
@?= Right
63+
[ (RepoName "a", CombineStrategyMerge)
64+
, (RepoName "c", CombineStrategyMerge)
65+
, (RepoName "b", CombineStrategyOverride)
66+
]
67+
, testCase "named repo absent from provided list gives Left" $
68+
organize
69+
( ActiveRepos
70+
[ ActiveRepoRest CombineStrategyMerge
71+
, ActiveRepo (RepoName "d") CombineStrategyOverride
72+
]
73+
)
74+
@?= Left "no repository provided d"
75+
, testCase "named repo against empty list gives Left" $
76+
organizeByRepos
77+
(ActiveRepos [ActiveRepo (RepoName "a") CombineStrategyMerge])
78+
id
79+
([] :: [RepoName])
80+
@?= Left "no repository provided a"
81+
, testCase "skip strategy is preserved in output" $
82+
organize
83+
( ActiveRepos
84+
[ ActiveRepo (RepoName "a") CombineStrategySkip
85+
, ActiveRepoRest CombineStrategyMerge
86+
]
87+
)
88+
@?= Right
89+
[ (RepoName "a", CombineStrategySkip)
90+
, (RepoName "b", CombineStrategyMerge)
91+
, (RepoName "c", CombineStrategyMerge)
92+
]
93+
, testCase ":rest with skip strategy skips all remaining repos" $
94+
organize (ActiveRepos [ActiveRepoRest CombineStrategySkip])
95+
@?= Right
96+
[ (RepoName "a", CombineStrategySkip)
97+
, (RepoName "b", CombineStrategySkip)
98+
, (RepoName "c", CombineStrategySkip)
99+
]
100+
]
101+
102+
-------------------------------------------------------------------------------
103+
-- filterSkippedActiveRepos
104+
-------------------------------------------------------------------------------
105+
106+
filterSkippedTests :: [TestTree]
107+
filterSkippedTests =
108+
[ testCase "skipped entries are removed when no :rest is present" $
109+
filterSkippedActiveRepos
110+
( ActiveRepos
111+
[ ActiveRepo (RepoName "a") CombineStrategyMerge
112+
, ActiveRepo (RepoName "b") CombineStrategySkip
113+
]
114+
)
115+
@?= ActiveRepos [ActiveRepo (RepoName "a") CombineStrategyMerge]
116+
, testCase "all-skipped list with no :rest yields empty" $
117+
filterSkippedActiveRepos
118+
( ActiveRepos
119+
[ ActiveRepo (RepoName "a") CombineStrategySkip
120+
, ActiveRepo (RepoName "b") CombineStrategySkip
121+
]
122+
)
123+
@?= ActiveRepos []
124+
, testCase "list without any skipped entries is unchanged" $
125+
let ar =
126+
ActiveRepos
127+
[ ActiveRepo (RepoName "a") CombineStrategyMerge
128+
, ActiveRepo (RepoName "b") CombineStrategyOverride
129+
]
130+
in filterSkippedActiveRepos ar @?= ar
131+
, testCase "skipped entries are kept when :rest is present" $
132+
-- filterSkippedActiveRepos is a no-op when ActiveRepoRest appears
133+
let ar =
134+
ActiveRepos
135+
[ ActiveRepoRest CombineStrategyMerge
136+
, ActiveRepo (RepoName "b") CombineStrategySkip
137+
]
138+
in filterSkippedActiveRepos ar @?= ar
139+
, testCase ":rest with skip strategy is kept unchanged" $
140+
let ar = ActiveRepos [ActiveRepoRest CombineStrategySkip]
141+
in filterSkippedActiveRepos ar @?= ar
142+
]
143+
144+
-------------------------------------------------------------------------------
145+
-- Parse/pretty roundtrip
146+
-------------------------------------------------------------------------------
147+
148+
prop_activeReposRoundtrip :: ActiveRepos -> Property
149+
prop_activeReposRoundtrip ar =
150+
counterexample ("prettyShow: " ++ prettyShow ar) $
151+
simpleParsec (prettyShow ar) === Just ar

0 commit comments

Comments
 (0)