merge queue: embarking master (867a039), #11401 and #11684 together

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

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

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

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]

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

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".
+
+}