[Git][ghc/ghc][master] Don't reload environment files on every setSessionDynFlags

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00
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.

- - - - -


6 changed files:

- compiler/GHC.hs
- + testsuite/tests/driver/T16318/Makefile
- + testsuite/tests/driver/T16318/all.T
- + testsuite/tests/driver/T18125/Makefile
- + testsuite/tests/driver/T18125/T18125.hs
- + testsuite/tests/driver/T18125/all.T


Changes:

=====================================
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


=====================================
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


=====================================
testsuite/tests/driver/T16318/all.T
=====================================
@@ -0,0 +1 @@
+test('T16318', normal, makefile_test, [])


=====================================
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


=====================================
testsuite/tests/driver/T18125/T18125.hs
=====================================
@@ -0,0 +1,2 @@
+module Main where
+main = putStrLn "hello world"


=====================================
testsuite/tests/driver/T18125/all.T
=====================================
@@ -0,0 +1 @@
+test('T18125', normal, makefile_test, [])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d880d6b2e48268f5ed4d3eb751fe24cc833e9221

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d880d6b2e48268f5ed4d3eb751fe24cc833e9221
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200513/3c82181a/attachment-0001.html>