From 2722e7ce955c5c18391d73d7534f89e0089df989 Mon Sep 17 00:00:00 2001 From: Shayne Fletcher Date: Mon, 30 Mar 2020 13:20:47 -0400 Subject: [PATCH] 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 --- daml-assistant/BUILD.bazel | 1 + .../src/DA/Daml/Assistant/IntegrationTests.hs | 6 ++--- .../test/DA/Daml/Assistant/Tests.hs | 26 +------------------ .../ts/codegen/tests/src/DA/Test/Daml2Ts.hs | 11 +++----- libs-haskell/test-utils/BUILD.bazel | 1 + libs-haskell/test-utils/DA/Test/Util.hs | 26 +++++++++++++++++++ 6 files changed, 35 insertions(+), 36 deletions(-) diff --git a/daml-assistant/BUILD.bazel b/daml-assistant/BUILD.bazel index d90ec63dec..1414b07efb 100644 --- a/daml-assistant/BUILD.bazel +++ b/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", ], ) diff --git a/daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs b/daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs index 144fce6089..acc73727cc 100644 --- a/daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs +++ b/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 diff --git a/daml-assistant/test/DA/Daml/Assistant/Tests.hs b/daml-assistant/test/DA/Daml/Assistant/Tests.hs index e28ba0f1dd..e2d3716e5f 100644 --- a/daml-assistant/test/DA/Daml/Assistant/Tests.hs +++ b/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 diff --git a/language-support/ts/codegen/tests/src/DA/Test/Daml2Ts.hs b/language-support/ts/codegen/tests/src/DA/Test/Daml2Ts.hs index 4b15bbcd14..b80424f6df 100644 --- a/language-support/ts/codegen/tests/src/DA/Test/Daml2Ts.hs +++ b/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: diff --git a/libs-haskell/test-utils/BUILD.bazel b/libs-haskell/test-utils/BUILD.bazel index 84638a3681..4980b18219 100644 --- a/libs-haskell/test-utils/BUILD.bazel +++ b/libs-haskell/test-utils/BUILD.bazel @@ -14,6 +14,7 @@ da_haskell_library( "extra", "filepath", "process", + "safe-exceptions", "tasty", "tasty-hunit", "text", diff --git a/libs-haskell/test-utils/DA/Test/Util.hs b/libs-haskell/test-utils/DA/Test/Util.hs index efbacfbd4e..467edd6bd1 100644 --- a/libs-haskell/test-utils/DA/Test/Util.hs +++ b/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)