Move 'withEnv', call it from daml2ts tests (#5276)

* Move 'withEnv', call it from daml2ts tests

changelog_begin
changelog_end

* Fix withEnv call to ensure that TASTY_NUM_THREADs is set

withEnv replaces the whole environment so we need to set everything we
care about.

* withEnv replaces the whole environment so we need to set everything we
care about.

* Apparently applying the same fix has destabilized Windows

* Try even harder to get daml assistant tests passing on Windows again

Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>

daml-assistant/BUILD.bazel

@@ -134,6 +134,7 @@ da_haskell_test(
         ":daml-lib",
         ":daml-project-config",
         "//libs-haskell/da-hs-base",
+        "//libs-haskell/test-utils",
     ],
 )
 

daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs

@@ -27,7 +27,7 @@ import System.FilePath
 import System.IO.Extra
 import System.Info.Extra
 import System.Process
-import Test.Main
+import Test.Main hiding (withEnv)
 import Test.Tasty
 import Test.Tasty.HUnit
 import qualified Web.JWT as JWT
@@ -41,9 +41,6 @@ import SdkVersion
 
 main :: IO ()
 main = do
-    -- We manipulate global state via the working directory and
-    -- the environment so running tests in parallel will cause trouble.
-    setEnv "TASTY_NUM_THREADS" "1" True
     yarn : damlTypesPath : args <- getArgs
     withTempDir $ \tmpDir -> do
     oldPath <- getSearchPath
@@ -61,6 +58,7 @@ main = do
     let mbCmdDir = takeDirectory <$> mbComSpec
     withArgs args (withEnv
         [ ("PATH", Just $ intercalate [searchPathSeparator] $ (tarPath : javaPath : mvnPath : yarnPath : oldPath) ++ maybeToList mbCmdDir)
+        , ("TASTY_NUM_THREADS", Just "1")
         ] $ defaultMain (tests tmpDir damlTypesDir))
 
 tests :: FilePath -> FilePath -> TestTree

daml-assistant/test/DA/Daml/Assistant/Tests.hs

@@ -18,13 +18,13 @@ import System.Info.Extra (isWindows)
 import System.IO.Temp
 import System.IO.Extra
 import Data.List.Extra
+import DA.Test.Util
 import qualified Test.Tasty as Tasty
 import qualified Test.Tasty.HUnit as Tasty
 import qualified Test.Tasty.QuickCheck as Tasty
 import qualified Data.Text as T
 import Test.Tasty.QuickCheck ((==>))
 import Data.Maybe
-import Control.Exception.Safe
 import Control.Monad
 import Conduit
 import qualified Data.Conduit.Zlib as Zlib
@@ -33,30 +33,6 @@ import qualified Data.Conduit.Tar as Tar
 -- unix specific
 import System.PosixCompat.Files (createSymbolicLink)
 
--- | Set the given environment variables, then restore them.
--- Envirnoment variables not in the given list are unmodified.
---
--- Avoids System.Environment.setEnv because it treats empty strings as
--- "delete environment variable", unlike main-tester's withEnv which
--- consequently conflates (Just "") with Nothing.
-withEnv :: [(String, Maybe String)] -> IO t -> IO t
-withEnv vs m = bracket pushEnv popEnv (const m)
-    where
-        pushEnv :: IO [(String, Maybe String)]
-        pushEnv = replaceEnv vs
-
-        popEnv :: [(String, Maybe String)] -> IO ()
-        popEnv vs' = void $ replaceEnv vs'
-
-        replaceEnv :: [(String, Maybe String)] -> IO [(String, Maybe String)]
-        replaceEnv vs' = do
-            forM vs' $ \(key, newVal) -> do
-                oldVal <- getEnv key
-                case newVal of
-                    Nothing -> unsetEnv key
-                    Just val -> setEnv key val True
-                pure (key, oldVal)
-
 main :: IO ()
 main = do
     setEnv "TASTY_NUM_THREADS" "1" True -- we need this because we use withEnv in our tests

language-support/ts/codegen/tests/src/DA/Test/Daml2Ts.hs

@@ -32,20 +32,17 @@ typescriptEslintVersion = "^2.16.0"
 
 main :: IO ()
 main = do
-    setEnv "TASTY_NUM_THREADS" "1" True
-    -- We manipulate global state via the working directory and
-    -- the environment so running tests in parallel will cause trouble.
     yarnPath : damlTypesPath : args <- getArgs
     damlc <- locateRunfiles (mainWorkspace </> "compiler" </> "damlc" </> exe "damlc")
     daml2ts <- locateRunfiles (mainWorkspace </> "language-support" </> "ts" </> "codegen" </> exe "daml2ts")
     yarn <- locateRunfiles (mainWorkspace </> yarnPath)
     damlTypes <- locateRunfiles (mainWorkspace </> damlTypesPath)
     davl <- locateRunfiles ("davl" </> "released")
-    -- TODO (SF,2020-03-24): Factor out 'withEnv' from
-    -- 'DA/DamlAssistant/Tests.hs' into a library function and use it here.
     oldPath <- getSearchPath
-    setEnv "PATH" (intercalate [searchPathSeparator] $ takeDirectory yarn : oldPath) True
-    withArgs args (defaultMain $ tests damlTypes yarn damlc daml2ts davl)
+    withArgs args $ withEnv
+        [ ("PATH", Just $ intercalate [searchPathSeparator] $ takeDirectory yarn : oldPath)
+        , ("TASTY_NUM_THREADS", Just "1")
+        ] $ defaultMain (tests damlTypes yarn damlc daml2ts davl)
 
 -- It may help to keep in mind for the following tests, this quick
 -- refresher on the layout of a simple project:

libs-haskell/test-utils/BUILD.bazel

@@ -14,6 +14,7 @@ da_haskell_library(
         "extra",
         "filepath",
         "process",
+        "safe-exceptions",
         "tasty",
         "tasty-hunit",
         "text",

libs-haskell/test-utils/DA/Test/Util.hs

@@ -8,13 +8,17 @@ module DA.Test.Util (
     assertInfixOf,
     withTempFileResource,
     withTempDirResource,
+    withEnv,
     nullDevice,
 ) where
 
+import Control.Monad
+import Control.Exception.Safe
 import Data.List.Extra (isInfixOf)
 import qualified Data.Text as T
 import System.IO.Extra
 import System.Info.Extra
+import System.Environment.Blank
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -43,3 +47,25 @@ nullDevice
     -- taken from typed-process
     | isWindows = "\\\\.\\NUL"
     | otherwise =  "/dev/null"
+
+-- | Replace all environment variables for test action, then restore them.
+-- Avoids System.Environment.setEnv because it treats empty strings as
+-- "delete environment variable", unlike main-tester's withEnv which
+-- consequently conflates (Just "") with Nothing.
+withEnv :: [(String, Maybe String)] -> IO t -> IO t
+withEnv vs m = bracket pushEnv popEnv (const m)
+    where
+        pushEnv :: IO [(String, Maybe String)]
+        pushEnv = replaceEnv vs
+
+        popEnv :: [(String, Maybe String)] -> IO ()
+        popEnv vs' = void $ replaceEnv vs'
+
+        replaceEnv :: [(String, Maybe String)] -> IO [(String, Maybe String)]
+        replaceEnv vs' = do
+            forM vs' $ \(key, newVal) -> do
+                oldVal <- getEnv key
+                case newVal of
+                    Nothing -> unsetEnv key
+                    Just val -> setEnv key val True
+                pure (key, oldVal)