Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 06fde293 by fendor at 2026-08-28T06:06:44-04:00 GHCi: Fix order of `PackageDBFlag`s for interactive home unit `PackageDBFlag`s are stored in reverse order of cli specification. When sorting the `PackageDBFlag`s by longest common prefix, we need thus to reverse the package db stacks before calculating the prefix. We make sure to reverse the package db stack for the interactive home unit to uphold that later specified package dbs overwrite earlier ones. Resolved and adds regression test for #27640 - - - - - 14 changed files: - changelog.d/T27202 - ghc/GHCi/UI.hs - + testsuite/tests/ghci/prog-mhu007/Makefile - + testsuite/tests/ghci/prog-mhu007/a/A.hs - + testsuite/tests/ghci/prog-mhu007/all.T - + testsuite/tests/ghci/prog-mhu007/b/B.hs - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script - + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs - + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg - + testsuite/tests/ghci/prog-mhu007/unitA - + testsuite/tests/ghci/prog-mhu007/unitB Changes: ===================================== changelog.d/T27202 ===================================== @@ -1,7 +1,7 @@ section: ghci synopsis: Fix regression to honour module targets in nested directories into GHCi after startup. -issues: #27202 -mrs: !15980 +issues: #27202 #27640 +mrs: !15980 !16591 description: { Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup. ===================================== ghc/GHCi/UI.hs ===================================== @@ -763,7 +763,7 @@ installInteractiveHomeUnits dflags = do -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there -- are not @-package-db@ arguments in the base 'DynFlags'... -- To fix this, we look at the home units and merge their package dbs stacks. - -- We assume, that many package db stacks look almost identical, and only differ in view elements. + -- We assume, that many package db stacks look almost identical, and only differ in few unit databases. -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat -- the rest of the package db stacks. At last, we add the two result package db stacks. -- This should work reliably with cabal and stack, but it is hacky. @@ -864,8 +864,14 @@ installInteractiveHomeUnits dflags = do pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit)) concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag] - concatPackageDbStacksUsingLongestCommonPrefix stacks = + concatPackageDbStacksUsingLongestCommonPrefix stacks' = let + -- Package DB stacks are accumulated from the cli right to left. + -- E.g., @-clear-package-db -global-package-db@ is stored as + -- @[PackageDB GlobalPkgDb, ClearPackageDBs]@. + -- Hence, we reverse the stacks, before computing the longest common prefix, + -- otherwise the prefix won't match at all. + stacks = map List.reverse stacks' -- O (m * n) -- m ... Number of PackageDBFlag stacks -- n ... Size of the stacks @@ -873,8 +879,21 @@ installInteractiveHomeUnits dflags = do map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose prefix = longestCommonPrefix stacks + + -- We reverse each individual stack segment to maintain the relative order within in a package + -- db stack. + -- There should be no 'ClearPackageDBs' in here, otherwise we are going to overwrite + -- the longest common prefix stacks. + -- + -- @nubOrd@ can silently change precedence of package db stack merging. + -- This is not trivially avoidable right now, since multiple home units could simply + -- have package db stacks that cannot be unified. + unmergeableStack = + nubOrd (concatMap (List.reverse . List.drop (length prefix)) stacks) in - prefix ++ nubOrd (concatMap (List.drop (length prefix)) stacks) + -- We reverse the final common package db stack again to match the expectation of 'packageDBFlags' that they are + -- stord in reverse order. + unmergeableStack ++ reverse prefix reportError :: GhciMonad m => GhciCommandMessage -> m () reportError err = do ===================================== testsuite/tests/ghci/prog-mhu007/Makefile ===================================== @@ -0,0 +1,33 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +PKGCONF_FOO=local-foo.package.conf +PKGCONF_BAR=local-bar.package.conf +LOCAL_GHC_PKG_FOO = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_FOO) +LOCAL_GHC_PKG_BAR = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_BAR) + +# Finds both packages in different unit databases +.PHONY: prog-mhu007 +prog-mhu007: + cd testpkg-foo && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-foo-0.1.0.0 -this-unit-id testpkg-foo-0.1.0.0-XXX \ + -i. Foo + cd testpkg-bar && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-bar-0.1.0.0 -this-unit-id testpkg-bar-0.1.0.0-XXX \ + -i. Bar + + $(LOCAL_GHC_PKG_FOO) init $(PKGCONF_FOO) 2>/dev/null + $(LOCAL_GHC_PKG_FOO) register --force testpkg-foo/testpkg-foo.pkg 2>/dev/null + $(LOCAL_GHC_PKG_FOO) hide testpkg-foo + $(LOCAL_GHC_PKG_FOO) list + + $(LOCAL_GHC_PKG_BAR) init $(PKGCONF_BAR) 2>/dev/null + $(LOCAL_GHC_PKG_BAR) register --force testpkg-bar/testpkg-bar.pkg 2>/dev/null + $(LOCAL_GHC_PKG_BAR) hide testpkg-bar + $(LOCAL_GHC_PKG_BAR) list + + '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \ + -no-user-package-db -fno-code -unit @unitA -unit @unitB < prog-mhu007.script ===================================== testsuite/tests/ghci/prog-mhu007/a/A.hs ===================================== @@ -0,0 +1,3 @@ +module A where + +import Bar ===================================== testsuite/tests/ghci/prog-mhu007/all.T ===================================== @@ -0,0 +1,8 @@ + +proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB', 'testpkg-bar/', 'testpkg-foo/']) + +test('prog-mhu007', + [proj_files, + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + req_interp], + makefile_test, ['prog-mhu007']) ===================================== testsuite/tests/ghci/prog-mhu007/b/B.hs ===================================== @@ -0,0 +1,3 @@ +module B where + +import Foo ===================================== testsuite/tests/ghci/prog-mhu007/prog-mhu007.script ===================================== @@ -0,0 +1,5 @@ +:m + A B +"Loaded A and B" +import Foo +import Bar +"Loaded dependencies Foo and Bar" ===================================== testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout ===================================== @@ -0,0 +1,10 @@ +Reading package info from "testpkg-foo/testpkg-foo.pkg" ... done. +local-foo.package.conf + (testpkg-foo-0.1.0.0) + +Reading package info from "testpkg-bar/testpkg-bar.pkg" ... done. +local-bar.package.conf + (testpkg-bar-0.1.0.0) + +"Loaded A and B" +"Loaded dependencies Foo and Bar" ===================================== testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs ===================================== @@ -0,0 +1 @@ +module Bar where ===================================== testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg ===================================== @@ -0,0 +1,11 @@ +name: testpkg-bar +version: 0.1.0.0 +id: testpkg-bar-0.1.0.0-XXX +key: testpkg-bar-0.1.0.0-XXX +exposed: True +exposed-modules: Bar +hidden-modules: +import-dirs: ${pkgroot}/testpkg-bar/dist-testpkg-bar-0.1.0.0 +library-dirs: +include-dirs: +hs-libraries: ===================================== testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs ===================================== @@ -0,0 +1 @@ +module Foo where ===================================== testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg ===================================== @@ -0,0 +1,11 @@ +name: testpkg-foo +version: 0.1.0.0 +id: testpkg-foo-0.1.0.0-XXX +key: testpkg-foo-0.1.0.0-XXX +exposed: True +exposed-modules: Foo +hidden-modules: +import-dirs: ${pkgroot}/testpkg-foo/dist-testpkg-foo-0.1.0.0 +library-dirs: +include-dirs: +hs-libraries: ===================================== testsuite/tests/ghci/prog-mhu007/unitA ===================================== @@ -0,0 +1,11 @@ +-i +-ia/ +A +-this-unit-id a-0.0.0 +-this-package-name a +-clear-package-db +-global-package-db +-no-user-package-db +-package-db local-bar.package.conf +-package base +-package-id testpkg-bar-0.1.0.0-XXX ===================================== testsuite/tests/ghci/prog-mhu007/unitB ===================================== @@ -0,0 +1,11 @@ +-i +-ib/ +B +-this-unit-id b-0.0.0 +-this-package-name b +-clear-package-db +-global-package-db +-no-user-package-db +-package-db local-foo.package.conf +-package base +-package-id testpkg-foo-0.1.0.0-XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06fde293f2e8c80db11f4d01fcdfc482... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06fde293f2e8c80db11f4d01fcdfc482... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help