diff options
| author | Artem Pelenitsyn <a.pelenitsyn@gmail.com> | 2020-05-03 04:56:59 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-13 20:04:11 -0400 |
| commit | d880d6b2e48268f5ed4d3eb751fe24cc833e9221 (patch) | |
| tree | 619cd0162576e8f502e96d8ea883f64aa386d980 | |
| parent | d7e0b57fda289e2715e7be86d4871503e3c09ee8 (diff) | |
| download | haskell-d880d6b2e48268f5ed4d3eb751fe24cc833e9221.tar.gz | |
Don't reload environment files on every setSessionDynFlags
Makes `interpretPackageEnv` (which loads envirinment files) a part of
`parseDynamicFlags` (parsing command-line arguments, which is typically
done once) instead of `setSessionDynFlags` (which is typically called
several times). Making several (transitive) calls to `interpretPackageEnv`,
as before, caused #18125 #16318, which should be fixed now.
| -rw-r--r-- | compiler/GHC.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/driver/T16318/Makefile | 11 | ||||
| -rw-r--r-- | testsuite/tests/driver/T16318/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/driver/T18125/Makefile | 13 | ||||
| -rw-r--r-- | testsuite/tests/driver/T18125/T18125.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/driver/T18125/all.T | 1 |
6 files changed, 34 insertions, 3 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index 19c5b59901..b92f0de3f0 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -597,8 +597,7 @@ checkBrokenTablesNextToCode' dflags setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId] setSessionDynFlags dflags = do dflags' <- checkNewDynFlags dflags - dflags'' <- liftIO $ interpretPackageEnv dflags' - (dflags''', preload) <- liftIO $ initPackages dflags'' + (dflags''', preload) <- liftIO $ initPackages dflags' -- Interpreter interp <- if gopt Opt_ExternalInterpreter dflags @@ -715,7 +714,11 @@ getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h)) parseDynamicFlags :: MonadIO m => DynFlags -> [Located String] -> m (DynFlags, [Located String], [Warn]) -parseDynamicFlags = parseDynamicFlagsCmdLine +parseDynamicFlags dflags cmdline = do + (dflags1, leftovers, warns) <- parseDynamicFlagsCmdLine dflags cmdline + dflags2 <- liftIO $ interpretPackageEnv dflags1 + return (dflags2, leftovers, warns) + -- | Checks the set of new DynFlags for possibly erroneous option -- combinations when invoking 'setSessionDynFlags' and friends, and if diff --git a/testsuite/tests/driver/T16318/Makefile b/testsuite/tests/driver/T16318/Makefile new file mode 100644 index 0000000000..e3cf881247 --- /dev/null +++ b/testsuite/tests/driver/T16318/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +test_pe = test-package-environment + +T16318: + $(GHC_PKG) latest base > $(test_pe) + "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 + C=`cat out | grep "Loaded package environment" -c` ; \ + if [ $$C != "1" ]; then false; fi diff --git a/testsuite/tests/driver/T16318/all.T b/testsuite/tests/driver/T16318/all.T new file mode 100644 index 0000000000..131ede819d --- /dev/null +++ b/testsuite/tests/driver/T16318/all.T @@ -0,0 +1 @@ +test('T16318', normal, makefile_test, []) diff --git a/testsuite/tests/driver/T18125/Makefile b/testsuite/tests/driver/T18125/Makefile new file mode 100644 index 0000000000..0a24d74610 --- /dev/null +++ b/testsuite/tests/driver/T18125/Makefile @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +test_pe = test-package-environment +test_lib = containers + +T18125: + $(GHC_PKG) latest base > $(test_pe) + $(GHC_PKG) latest $(test_lib) >> $(test_pe) + "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 + C=`cat out | grep "$(test_lib)" -c` ; \ + if [ $$C != "1" ]; then false; fi diff --git a/testsuite/tests/driver/T18125/T18125.hs b/testsuite/tests/driver/T18125/T18125.hs new file mode 100644 index 0000000000..3496a8e45c --- /dev/null +++ b/testsuite/tests/driver/T18125/T18125.hs @@ -0,0 +1,2 @@ +module Main where +main = putStrLn "hello world" diff --git a/testsuite/tests/driver/T18125/all.T b/testsuite/tests/driver/T18125/all.T new file mode 100644 index 0000000000..a094ef2974 --- /dev/null +++ b/testsuite/tests/driver/T18125/all.T @@ -0,0 +1 @@ +test('T18125', normal, makefile_test, []) |