diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs index 6945dd58ae9..a8fa649aef2 100644 --- a/Cabal/src/Distribution/Simple/PreProcess.hs +++ b/Cabal/src/Distribution/Simple/PreProcess.hs @@ -794,7 +794,7 @@ platformDefines lbi = Android -> ["android"] Ghcjs -> ["ghcjs"] Wasi -> ["wasi"] - Hurd -> ["hurd"] + Hurd -> ["gnu"] Haiku -> ["haiku"] OtherOS _ -> [] archStr = case hostArch of diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 62c5ac63e45..9eef7f206c6 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -341,6 +341,7 @@ test-suite unit-tests UnitTests.Distribution.Client.Glob UnitTests.Distribution.Client.GZipUtils UnitTests.Distribution.Client.IndexUtils + UnitTests.Distribution.Client.IndexUtils.ActiveRepos UnitTests.Distribution.Client.IndexUtils.Timestamp UnitTests.Distribution.Client.Init UnitTests.Distribution.Client.Init.Golden diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs index 8434f623e82..0020c695d12 100644 --- a/cabal-install/tests/UnitTests.hs +++ b/cabal-install/tests/UnitTests.hs @@ -9,6 +9,7 @@ import qualified UnitTests.Distribution.Client.GZipUtils import qualified UnitTests.Distribution.Client.Get import qualified UnitTests.Distribution.Client.Glob import qualified UnitTests.Distribution.Client.IndexUtils +import qualified UnitTests.Distribution.Client.IndexUtils.ActiveRepos import qualified UnitTests.Distribution.Client.IndexUtils.Timestamp import qualified UnitTests.Distribution.Client.Init import qualified UnitTests.Distribution.Client.InstallPlan @@ -52,6 +53,9 @@ main = do , testGroup "UnitTests.Distribution.Client.IndexUtils" UnitTests.Distribution.Client.IndexUtils.tests + , testGroup + "UnitTests.Distribution.Client.IndexUtils.ActiveRepos" + UnitTests.Distribution.Client.IndexUtils.ActiveRepos.tests , testGroup "UnitTests.Distribution.Client.IndexUtils.Timestamp" UnitTests.Distribution.Client.IndexUtils.Timestamp.tests diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs index fbd5952019a..d5ccc58e8c9 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs @@ -1,21 +1,29 @@ module UnitTests.Distribution.Client.IndexUtils where import Distribution.Client.IndexUtils +import Distribution.Client.IndexUtils.ActiveRepos import qualified Distribution.Compat.NonEmptySet as NES +import Distribution.Package import Distribution.Simple.Utils (toUTF8LBS) -import Distribution.Types.Dependency +import qualified Distribution.Solver.Types.PackageIndex as PackageIndex import Distribution.Types.LibraryName -import Distribution.Types.PackageName import Distribution.Version +import Data.List (sort) + import Test.Tasty import Test.Tasty.HUnit tests :: [TestTree] tests = [ simpleVersionsParserTests + , indexCombiningTests ] +-- --------------------------------------------------------------------------- +-- Preferred-versions parser tests +-- --------------------------------------------------------------------------- + simpleVersionsParserTests :: TestTree simpleVersionsParserTests = testGroup @@ -80,3 +88,115 @@ simpleVersionsParserTests = ] , preferredVersionsOriginalDependency = "binary 0.9.0.0 || > 0.9.0.0" } + +-- --------------------------------------------------------------------------- +-- Index-combining tests +-- +-- These test the addIndex / foldl' logic inside getSourcePackagesAtIndexState, +-- which applies CombineStrategy to a sequence of PackageIndex values: +-- +-- addIndex acc (_, Skip) = acc +-- addIndex acc (idx, Merge) = PackageIndex.merge acc idx +-- addIndex acc (idx, Override) = PackageIndex.override acc idx +-- pkgs = foldl' addIndex mempty pkgss' +-- --------------------------------------------------------------------------- + +indexCombiningTests :: TestTree +indexCombiningTests = + testGroup + "Index combining (CombineStrategy)" + [ testCase "Skip: repo contributes nothing" $ + pkgs [(repoFoo1, CombineStrategySkip)] + @?= [] + , testCase "Merge: single repo makes all its packages visible" $ + pkgs [(repoFoo1, CombineStrategyMerge)] + @?= [foo1] + , testCase "Override: single repo makes all its packages visible" $ + pkgs [(repoFoo1, CombineStrategyOverride)] + @?= [foo1] + , testCase "Merge+Merge: non-overlapping packages are both visible" $ + pkgs [(repoFoo1, CombineStrategyMerge), (repoBar1, CombineStrategyMerge)] + @?= sort [foo1, bar1] + , testCase "Merge+Merge: different versions of same package are both visible" $ + pkgs [(repoFoo1, CombineStrategyMerge), (repoFoo2, CombineStrategyMerge)] + @?= sort [foo1, foo2] + , testCase "Merge+Override: packages only in first repo remain visible" $ + pkgs [(repoFoo1, CombineStrategyMerge), (repoBar1, CombineStrategyOverride)] + @?= sort [foo1, bar1] + , testCase "Merge+Override: override repo replaces all versions of overlapping package" $ + -- repoFoo12 has foo-1.0 and foo-1.1; repoFoo2 has only foo-2.0. + -- Override means repoFoo2 wins the entire 'foo' bucket. + pkgs [(repoFoo12, CombineStrategyMerge), (repoFoo2, CombineStrategyOverride)] + @?= [foo2] + , testCase "Merge+Override: override does not affect packages absent from override repo" $ + pkgs [(repoFoo1bar1, CombineStrategyMerge), (repoFoo2, CombineStrategyOverride)] + @?= sort [foo2, bar1] + , testCase "Skip in middle: skipped repo is ignored" $ + pkgs + [ (repoFoo1, CombineStrategyMerge) + , (repoFoo2, CombineStrategySkip) + , (repoBar1, CombineStrategyMerge) + ] + @?= sort [foo1, bar1] + , testCase "Skip+Merge: later merge after skip still contributes" $ + pkgs [(repoFoo1, CombineStrategySkip), (repoFoo2, CombineStrategyMerge)] + @?= [foo2] + , testCase "Override+Override: last override wins the package bucket" $ + pkgs + [ (repoFoo1, CombineStrategyMerge) + , (repoFoo2, CombineStrategyOverride) + , (repoFoo3, CombineStrategyOverride) + ] + @?= [foo3] + , testCase "Override+Merge: merge after override combines both buckets" $ + -- foo bucket starts as {foo-2.0} after override, then merges {foo-3.0} + -- giving {foo-2.0, foo-3.0} + pkgs + [ (repoFoo1, CombineStrategyMerge) + , (repoFoo2, CombineStrategyOverride) + , (repoFoo3, CombineStrategyMerge) + ] + @?= sort [foo2, foo3] + , testCase "All skip: result is empty" $ + pkgs + [ (repoFoo1, CombineStrategySkip) + , (repoFoo2, CombineStrategySkip) + ] + @?= [] + , testCase "Empty repos list: result is empty" $ + pkgs [] @?= [] + ] + +-- Mirrors the addIndex / foldl' in getSourcePackagesAtIndexState. +combineIndex + :: PackageIndex.PackageIndex PackageIdentifier + -> (PackageIndex.PackageIndex PackageIdentifier, CombineStrategy) + -> PackageIndex.PackageIndex PackageIdentifier +combineIndex acc (_, CombineStrategySkip) = acc +combineIndex acc (idx, CombineStrategyMerge) = PackageIndex.merge acc idx +combineIndex acc (idx, CombineStrategyOverride) = PackageIndex.override acc idx + +-- Run the combining fold and return the result as a sorted list of PackageIds. +pkgs + :: [(PackageIndex.PackageIndex PackageIdentifier, CombineStrategy)] + -> [PackageIdentifier] +pkgs = sort . PackageIndex.allPackages . foldl combineIndex mempty + +-- Test packages +foo1, foo2, foo3, bar1 :: PackageIdentifier +foo1 = PackageIdentifier (mkPackageName "foo") (mkVersion [1, 0]) +foo2 = PackageIdentifier (mkPackageName "foo") (mkVersion [2, 0]) +foo3 = PackageIdentifier (mkPackageName "foo") (mkVersion [3, 0]) +bar1 = PackageIdentifier (mkPackageName "bar") (mkVersion [1, 0]) + +-- Single-package indices +repoFoo1, repoFoo2, repoFoo3, repoBar1 :: PackageIndex.PackageIndex PackageIdentifier +repoFoo1 = PackageIndex.fromList [foo1] +repoFoo2 = PackageIndex.fromList [foo2] +repoFoo3 = PackageIndex.fromList [foo3] +repoBar1 = PackageIndex.fromList [bar1] + +-- Multi-package indices +repoFoo12, repoFoo1bar1 :: PackageIndex.PackageIndex PackageIdentifier +repoFoo12 = PackageIndex.fromList [foo1, foo2] +repoFoo1bar1 = PackageIndex.fromList [foo1, bar1] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/ActiveRepos.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/ActiveRepos.hs new file mode 100644 index 00000000000..fa1bf674f0e --- /dev/null +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/ActiveRepos.hs @@ -0,0 +1,152 @@ +module UnitTests.Distribution.Client.IndexUtils.ActiveRepos (tests) where + +import Distribution.Client.IndexUtils.ActiveRepos +import Distribution.Client.Types.RepoName (RepoName (..)) +import Distribution.Parsec (simpleParsec) +import Distribution.Pretty (prettyShow) + +import UnitTests.Distribution.Client.ArbitraryInstances () + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +tests :: [TestTree] +tests = + [ testGroup "organizeByRepos" organizeByReposTests + , testGroup "filterSkippedActiveRepos" filterSkippedTests + , testGroup + "parse/pretty roundtrip" + [ testProperty "ActiveRepos roundtrips" prop_activeReposRoundtrip + ] + ] + +------------------------------------------------------------------------------- +-- organizeByRepos +------------------------------------------------------------------------------- + +-- Convenience: run organizeByRepos over a fixed three-element repo list. +organize :: ActiveRepos -> Either String [(RepoName, CombineStrategy)] +organize ar = organizeByRepos ar id [RepoName "a", RepoName "b", RepoName "c"] + +organizeByReposTests :: [TestTree] +organizeByReposTests = + [ testCase ":rest assigns strategy to all repos in order" $ + organize (ActiveRepos [ActiveRepoRest CombineStrategyMerge]) + @?= Right + [ (RepoName "a", CombineStrategyMerge) + , (RepoName "b", CombineStrategyMerge) + , (RepoName "c", CombineStrategyMerge) + ] + , testCase ":none yields empty result" $ + organize (ActiveRepos []) + @?= Right [] + , testCase "named repo before :rest is placed first" $ + organize + ( ActiveRepos + [ ActiveRepo (RepoName "b") CombineStrategyOverride + , ActiveRepoRest CombineStrategyMerge + ] + ) + @?= Right + [ (RepoName "b", CombineStrategyOverride) + , (RepoName "a", CombineStrategyMerge) + , (RepoName "c", CombineStrategyMerge) + ] + , testCase "named repo after :rest is placed last" $ + organize + ( ActiveRepos + [ ActiveRepoRest CombineStrategyMerge + , ActiveRepo (RepoName "b") CombineStrategyOverride + ] + ) + @?= Right + [ (RepoName "a", CombineStrategyMerge) + , (RepoName "c", CombineStrategyMerge) + , (RepoName "b", CombineStrategyOverride) + ] + , testCase "named repo absent from provided list gives Left" $ + organize + ( ActiveRepos + [ ActiveRepoRest CombineStrategyMerge + , ActiveRepo (RepoName "d") CombineStrategyOverride + ] + ) + @?= Left "no repository provided d" + , testCase "named repo against empty list gives Left" $ + organizeByRepos + (ActiveRepos [ActiveRepo (RepoName "a") CombineStrategyMerge]) + id + ([] :: [RepoName]) + @?= Left "no repository provided a" + , testCase "skip strategy is preserved in output" $ + organize + ( ActiveRepos + [ ActiveRepo (RepoName "a") CombineStrategySkip + , ActiveRepoRest CombineStrategyMerge + ] + ) + @?= Right + [ (RepoName "a", CombineStrategySkip) + , (RepoName "b", CombineStrategyMerge) + , (RepoName "c", CombineStrategyMerge) + ] + , testCase ":rest with skip strategy skips all remaining repos" $ + organize (ActiveRepos [ActiveRepoRest CombineStrategySkip]) + @?= Right + [ (RepoName "a", CombineStrategySkip) + , (RepoName "b", CombineStrategySkip) + , (RepoName "c", CombineStrategySkip) + ] + ] + +------------------------------------------------------------------------------- +-- filterSkippedActiveRepos +------------------------------------------------------------------------------- + +filterSkippedTests :: [TestTree] +filterSkippedTests = + [ testCase "skipped entries are removed when no :rest is present" $ + filterSkippedActiveRepos + ( ActiveRepos + [ ActiveRepo (RepoName "a") CombineStrategyMerge + , ActiveRepo (RepoName "b") CombineStrategySkip + ] + ) + @?= ActiveRepos [ActiveRepo (RepoName "a") CombineStrategyMerge] + , testCase "all-skipped list with no :rest yields empty" $ + filterSkippedActiveRepos + ( ActiveRepos + [ ActiveRepo (RepoName "a") CombineStrategySkip + , ActiveRepo (RepoName "b") CombineStrategySkip + ] + ) + @?= ActiveRepos [] + , testCase "list without any skipped entries is unchanged" $ + let ar = + ActiveRepos + [ ActiveRepo (RepoName "a") CombineStrategyMerge + , ActiveRepo (RepoName "b") CombineStrategyOverride + ] + in filterSkippedActiveRepos ar @?= ar + , testCase "skipped entries are kept when :rest is present" $ + -- filterSkippedActiveRepos is a no-op when ActiveRepoRest appears + let ar = + ActiveRepos + [ ActiveRepoRest CombineStrategyMerge + , ActiveRepo (RepoName "b") CombineStrategySkip + ] + in filterSkippedActiveRepos ar @?= ar + , testCase ":rest with skip strategy is kept unchanged" $ + let ar = ActiveRepos [ActiveRepoRest CombineStrategySkip] + in filterSkippedActiveRepos ar @?= ar + ] + +------------------------------------------------------------------------------- +-- Parse/pretty roundtrip +------------------------------------------------------------------------------- + +prop_activeReposRoundtrip :: ActiveRepos -> Property +prop_activeReposRoundtrip ar = + counterexample ("prettyShow: " ++ prettyShow ar) $ + simpleParsec (prettyShow ar) === Just ar diff --git a/changelog.d/pr-11401 b/changelog.d/pr-11401 new file mode 100644 index 00000000000..37573b337bc --- /dev/null +++ b/changelog.d/pr-11401 @@ -0,0 +1,12 @@ +synopsis: Fix the OS string encoding for GNU/Hurd +packages: Cabal +prs: #11401 + +description: { + +Following [#9434](https://github.com/haskell/cabal/pull/9434/), and as seen +in the various `gnu_HOST_OS` uses in the GHC source code, it is expected that +GNU/Hurd is advertised as "gnu", so the OS String encoding for OSHurd was +corrected to "gnu". + +}