From bfb075de03c8dce11aceb8c74d43144b21ece03b Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Sun, 5 Jan 2025 03:54:46 -0800 Subject: [PATCH] Add more diagnostics to isolateEnvironment.setEnvs --- tests/Util.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/tests/Util.hs b/tests/Util.hs index 1a5ad57a..18cd4505 100644 --- a/tests/Util.hs +++ b/tests/Util.hs @@ -144,6 +144,17 @@ withNewDirectory keep dir action = do where cleanup dir' | keep = return () | otherwise = removePathForcibly dir' +diffAscAssoc + :: (Ord a, Eq b) => (b -> c) -> [(a, b)] -> [(a, b)] -> [(a, Either c c)] +diffAscAssoc _ [] [] = [] +diffAscAssoc f ((k, v) : kvs) [] = (k, Left (f v)) : diffAscAssoc f kvs [] +diffAscAssoc f [] ((k, v) : kvs) = (k, Right (f v)) : diffAscAssoc f [] kvs +diffAscAssoc f ((k, v) : kvs) ((k', v') : kvs') + | k < k' = (k, Left (f v)) : diffAscAssoc f kvs ((k', v') : kvs') + | k > k' = (k', Right (f v')) : diffAscAssoc f ((k, v) : kvs) kvs' + | v /= v' = (k, Left (f v)) : (k', Right (f v')) : diffAscAssoc f kvs kvs' + | otherwise = diffAscAssoc f kvs kvs' + isolateEnvironment :: IO a -> IO a isolateEnvironment = bracket getEnvs setEnvs . const where @@ -153,8 +164,9 @@ isolateEnvironment = bracket getEnvs setEnvs . const updateEnvs current target new <- getEnvs when (target /= new) $ do - -- Environment variables may be sensitive, so don't log them. - throwIO (userError "isolateEnvironment.setEnvs failed") + let diff = diffAscAssoc length target new + -- Environment variables may be sensitive, so don't log their values. + throwIO (userError ("isolateEnvironment.setEnvs failed" <> show diff)) updateEnvs kvs1@((k1, v1) : kvs1') kvs2@((k2, v2) : kvs2') = case compare k1 k2 of LT -> unsetEnv k1 *> updateEnvs kvs1' kvs2