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 3 
     issues: #27202
    4 
    -mrs: !15980
    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
    ... ... @@ -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 
    +        -- @[GlobalPackageDb, ClearPackageDb]@.
    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,22 @@ 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.
    884 
    +        -- There should be no 'ClearPackageDb' in here, otherwise we are going to overwrite
    885 
    +        -- the longest common prefix stacks.
    886 
    +        unmergableStack =
    887 
    +          nubOrd (concatMap (List.reverse . List.drop (length prefix)) stacks)
    876 888 
           in
    877 
    -        prefix ++ nubOrd (concatMap (List.drop (length prefix)) stacks)
    889 
    +        -- We reverse the final common package db stack again to match the expectation of 'packageDBFlags' that they are
    890 
    +        -- stord in reverse order.
    891 
    +        unmergableStack ++ reverse prefix
    892 
    +
    893 
    +-- [[d, b, a], [c, b, a]]
    894 
    +-- [[a, b, d], [a, b, c]]
    895 
    +-- [a, b], [[d], [c]]
    896 
    +-- [d, c,]
    897 
    +-- [d, c, b, a]
    878 898
    879 899 
     reportError :: GhciMonad m => GhciCommandMessage -> m ()
    880 900 
     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

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/e2c011e7a9287f420eb88262b3480ab5c48ef296 at 1787729897