Hannes Siebenhandl pushed to branch wip/fendor/ghc-ghci-mhu-27640 at Glasgow Haskell Compiler / GHC

Commits:

14 changed files:

Changes:

  • changelog.d/T27202
    1 1
     section: ghci
    
    2 2
     synopsis: Fix regression to honour module targets in nested directories into GHCi after startup.
    
    3
    -issues: #27202
    
    4
    -mrs: !15980
    
    3
    +issues: #27202 #27640
    
    4
    +mrs: !15980 !16591
    
    5 5
     
    
    6 6
     description: {
    
    7 7
         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
    763 763
         -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there
    
    764 764
         -- are not @-package-db@ arguments in the base 'DynFlags'...
    
    765 765
         -- To fix this, we look at the home units and merge their package dbs stacks.
    
    766
    -    -- We assume, that many package db stacks look almost identical, and only differ in view elements.
    
    766
    +    -- We assume, that many package db stacks look almost identical, and only differ in few unit databases.
    
    767 767
         -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat
    
    768 768
         -- the rest of the package db stacks. At last, we add the two result package db stacks.
    
    769 769
         -- This should work reliably with cabal and stack, but it is hacky.
    
    ... ... @@ -864,8 +864,14 @@ installInteractiveHomeUnits dflags = do
    864 864
           pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit))
    
    865 865
     
    
    866 866
         concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
    
    867
    -    concatPackageDbStacksUsingLongestCommonPrefix stacks =
    
    867
    +    concatPackageDbStacksUsingLongestCommonPrefix stacks' =
    
    868 868
           let
    
    869
    +        -- Package DB stacks are accumulated from the cli right to left.
    
    870
    +        -- E.g., @-clear-package-db -global-package-db@ is stored as
    
    871
    +        -- @[PackageDB GlobalPkgDb, ClearPackageDBs]@.
    
    872
    +        -- Hence, we reverse the stacks, before computing the longest common prefix,
    
    873
    +        -- otherwise the prefix won't match at all.
    
    874
    +        stacks = map List.reverse stacks'
    
    869 875
             -- O (m * n)
    
    870 876
             -- m ... Number of PackageDBFlag stacks
    
    871 877
             -- n ... Size of the stacks
    
    ... ... @@ -873,8 +879,21 @@ installInteractiveHomeUnits dflags = do
    873 879
               map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose
    
    874 880
             prefix =
    
    875 881
               longestCommonPrefix stacks
    
    882
    +
    
    883
    +        -- We reverse each individual stack segment to maintain the relative order within in a package
    
    884
    +        -- db stack.
    
    885
    +        -- There should be no 'ClearPackageDBs' in here, otherwise we are going to overwrite
    
    886
    +        -- the longest common prefix stacks.
    
    887
    +        --
    
    888
    +        -- @nubOrd@ can silently change precedence of package db stack merging.
    
    889
    +        -- This is not trivially avoidable right now, since multiple home units could simply
    
    890
    +        -- have package db stacks that cannot be unified.
    
    891
    +        unmergeableStack =
    
    892
    +          nubOrd (concatMap (List.reverse . List.drop (length prefix)) stacks)
    
    876 893
           in
    
    877
    -        prefix ++ nubOrd (concatMap (List.drop (length prefix)) stacks)
    
    894
    +        -- We reverse the final common package db stack again to match the expectation of 'packageDBFlags' that they are
    
    895
    +        -- stord in reverse order.
    
    896
    +        unmergeableStack ++ reverse prefix
    
    878 897
     
    
    879 898
     reportError :: GhciMonad m => GhciCommandMessage -> m ()
    
    880 899
     reportError err = do
    

  • testsuite/tests/ghci/prog-mhu007/Makefile
    1
    +TOP=../../..
    
    2
    +include $(TOP)/mk/boilerplate.mk
    
    3
    +include $(TOP)/mk/test.mk
    
    4
    +
    
    5
    +PKGCONF_FOO=local-foo.package.conf
    
    6
    +PKGCONF_BAR=local-bar.package.conf
    
    7
    +LOCAL_GHC_PKG_FOO = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_FOO)
    
    8
    +LOCAL_GHC_PKG_BAR = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_BAR)
    
    9
    +
    
    10
    +# Finds both packages in different unit databases
    
    11
    +.PHONY: prog-mhu007
    
    12
    +prog-mhu007:
    
    13
    +	cd testpkg-foo && \
    
    14
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    
    15
    +			-v0 -fno-code -fwrite-interface -hidir dist-testpkg-foo-0.1.0.0 -this-unit-id testpkg-foo-0.1.0.0-XXX  \
    
    16
    +			-i. Foo
    
    17
    +	cd testpkg-bar && \
    
    18
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    
    19
    +			-v0 -fno-code -fwrite-interface -hidir dist-testpkg-bar-0.1.0.0 -this-unit-id testpkg-bar-0.1.0.0-XXX  \
    
    20
    +			-i. Bar
    
    21
    +
    
    22
    +	$(LOCAL_GHC_PKG_FOO) init $(PKGCONF_FOO) 2>/dev/null
    
    23
    +	$(LOCAL_GHC_PKG_FOO) register --force testpkg-foo/testpkg-foo.pkg 2>/dev/null
    
    24
    +	$(LOCAL_GHC_PKG_FOO) hide testpkg-foo
    
    25
    +	$(LOCAL_GHC_PKG_FOO) list
    
    26
    +
    
    27
    +	$(LOCAL_GHC_PKG_BAR) init $(PKGCONF_BAR) 2>/dev/null
    
    28
    +	$(LOCAL_GHC_PKG_BAR) register --force testpkg-bar/testpkg-bar.pkg 2>/dev/null
    
    29
    +	$(LOCAL_GHC_PKG_BAR) hide testpkg-bar
    
    30
    +	$(LOCAL_GHC_PKG_BAR) list
    
    31
    +
    
    32
    +	'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
    
    33
    +		-no-user-package-db -fno-code -unit @unitA -unit @unitB < prog-mhu007.script

  • testsuite/tests/ghci/prog-mhu007/a/A.hs
    1
    +module A where
    
    2
    +
    
    3
    +import Bar

  • testsuite/tests/ghci/prog-mhu007/all.T
    1
    +
    
    2
    +proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB', 'testpkg-bar/', 'testpkg-foo/'])
    
    3
    +
    
    4
    +test('prog-mhu007',
    
    5
    +     [proj_files,
    
    6
    +     cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
    
    7
    +     req_interp],
    
    8
    +     makefile_test, ['prog-mhu007'])

  • testsuite/tests/ghci/prog-mhu007/b/B.hs
    1
    +module B where
    
    2
    +
    
    3
    +import Foo

  • testsuite/tests/ghci/prog-mhu007/prog-mhu007.script
    1
    +:m + A B
    
    2
    +"Loaded A and B"
    
    3
    +import Foo
    
    4
    +import Bar
    
    5
    +"Loaded dependencies Foo and Bar"

  • testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout
    1
    +Reading package info from "testpkg-foo/testpkg-foo.pkg" ... done.
    
    2
    +local-foo.package.conf
    
    3
    +    (testpkg-foo-0.1.0.0)
    
    4
    +
    
    5
    +Reading package info from "testpkg-bar/testpkg-bar.pkg" ... done.
    
    6
    +local-bar.package.conf
    
    7
    +    (testpkg-bar-0.1.0.0)
    
    8
    +
    
    9
    +"Loaded A and B"
    
    10
    +"Loaded dependencies Foo and Bar"

  • testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs
    1
    +module Bar where

  • testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg
    1
    +name: testpkg-bar
    
    2
    +version: 0.1.0.0
    
    3
    +id: testpkg-bar-0.1.0.0-XXX
    
    4
    +key: testpkg-bar-0.1.0.0-XXX
    
    5
    +exposed: True
    
    6
    +exposed-modules: Bar
    
    7
    +hidden-modules:
    
    8
    +import-dirs: ${pkgroot}/testpkg-bar/dist-testpkg-bar-0.1.0.0
    
    9
    +library-dirs:
    
    10
    +include-dirs:
    
    11
    +hs-libraries:

  • testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs
    1
    +module Foo where

  • testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg
    1
    +name: testpkg-foo
    
    2
    +version: 0.1.0.0
    
    3
    +id: testpkg-foo-0.1.0.0-XXX
    
    4
    +key: testpkg-foo-0.1.0.0-XXX
    
    5
    +exposed: True
    
    6
    +exposed-modules: Foo
    
    7
    +hidden-modules:
    
    8
    +import-dirs: ${pkgroot}/testpkg-foo/dist-testpkg-foo-0.1.0.0
    
    9
    +library-dirs:
    
    10
    +include-dirs:
    
    11
    +hs-libraries:

  • testsuite/tests/ghci/prog-mhu007/unitA
    1
    +-i
    
    2
    +-ia/
    
    3
    +A
    
    4
    +-this-unit-id a-0.0.0
    
    5
    +-this-package-name a
    
    6
    +-clear-package-db
    
    7
    +-global-package-db
    
    8
    +-no-user-package-db
    
    9
    +-package-db local-bar.package.conf
    
    10
    +-package base
    
    11
    +-package-id testpkg-bar-0.1.0.0-XXX

  • testsuite/tests/ghci/prog-mhu007/unitB
    1
    +-i
    
    2
    +-ib/
    
    3
    +B
    
    4
    +-this-unit-id b-0.0.0
    
    5
    +-this-package-name b
    
    6
    +-clear-package-db
    
    7
    +-global-package-db
    
    8
    +-no-user-package-db
    
    9
    +-package-db local-foo.package.conf
    
    10
    +-package base
    
    11
    +-package-id testpkg-foo-0.1.0.0-XXX