diff --git a/Cabal/Distribution/Compat/Environment.hs b/Cabal/Distribution/Compat/Environment.hs index 093909e737535a725254d09199e00adc1bce9cf6..d0279b05d81b5b1cb7462f0695ee0cdce0267f82 100644 --- a/Cabal/Distribution/Compat/Environment.hs +++ b/Cabal/Distribution/Compat/Environment.hs @@ -3,15 +3,24 @@ {-# OPTIONS_HADDOCK hide #-} module Distribution.Compat.Environment - ( getEnvironment, lookupEnv, setEnv ) + ( getEnvironment, lookupEnv, setEnv, unsetEnv ) where import Prelude () import Distribution.Compat.Prelude +#ifndef mingw32_HOST_OS +#if __GLASGOW_HASKELL__ < 708 +import Foreign.C.Error (throwErrnoIf_) +#endif +#endif + import qualified System.Environment as System #if __GLASGOW_HASKELL__ >= 706 import System.Environment (lookupEnv) +#if __GLASGOW_HASKELL__ >= 708 +import System.Environment (unsetEnv) +#endif #else import Distribution.Compat.Exception (catchIO) #endif @@ -86,3 +95,34 @@ setEnv_ key value = do foreign import ccall unsafe "setenv" c_setenv :: CString -> CString -> CInt -> IO CInt #endif /* mingw32_HOST_OS */ + +#if __GLASGOW_HASKELL__ < 708 + +-- | @unsetEnv name@ removes the specified environment variable from the +-- environment of the current process. +-- +-- Throws `Control.Exception.IOException` if @name@ is the empty string or +-- contains an equals sign. +-- +-- @since 4.7.0.0 +unsetEnv :: String -> IO () +#ifdef mingw32_HOST_OS +unsetEnv key = withCWString key $ \k -> do + success <- c_SetEnvironmentVariable k nullPtr + unless success $ do + -- We consider unsetting an environment variable that does not exist not as + -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND. + err <- c_GetLastError + unless (err == eRROR_ENVVAR_NOT_FOUND) $ do + throwGetLastError "unsetEnv" +#else +unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv) +#if __GLASGOW_HASKELL__ > 706 +foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> IO CInt +#else +-- HACK: We hope very hard that !UNSETENV_RETURNS_VOID +foreign import ccall unsafe "unsetenv" c_unsetenv :: CString -> IO CInt +#endif +#endif + +#endif