test-sandbox 0.1.4 → 0.1.5

raw patch · 4 files changed

+37/−12 lines, 4 files

Files

• ChangeLog.md +4/−0
• src/Test/Sandbox.hs +13/−3
• src/Test/Sandbox/Internals.hs +18/−7
• test-sandbox.cabal +2/−2

@@ -1,3 +1,7 @@+## 0.1.5++* Add the function of changing environment-variables and working-directory with register-function-arguments.+ ## 0.1.4  * Allow '.' and '-' for valid procsss name

@@ -128,13 +128,20 @@     liftIO $ actions ref  -- | Optional parameters when registering a process in the Sandbox monad.-data ProcessSettings = ProcessSettings {+data ProcessSettings =+  ProcessSettings {     psWait :: Maybe Int        -- ^ Time to wait (in s.) before checking that the process is still up   , psCapture :: Maybe Capture -- ^ Which outputs to capture (if any)+  } |+  ProcessSettings2 {+    psWait :: Maybe Int              -- ^ Time to wait (in s.) before checking that the process is still up+  , psCapture :: Maybe Capture       -- ^ Which outputs to capture (if any)+  , psEnv :: Maybe [(String,String)] -- ^ Environment variables+  , psCwd :: Maybe FilePath          -- ^ Working directory for the new process   }  instance Default ProcessSettings where-  def = ProcessSettings (Just 1) Nothing+  def = ProcessSettings2 (Just 1) Nothing Nothing Nothing  -- | Registers a process in the Sandbox monad. register :: String          -- ^ Process name@@ -142,7 +149,10 @@          -> [String]        -- ^ Arguments to pass on the command-line          -> ProcessSettings -- ^ Process settings          -> Sandbox String-register name bin args params = registerProcess name bin args (psWait params) (psCapture params) >> return name+register name bin args (ProcessSettings wait capture) =+  registerProcess name bin args wait capture Nothing Nothing >> return name+register name bin args (ProcessSettings2 wait capture env cwd) =+  registerProcess name bin args wait capture env cwd >> return name  -- | Communicates with a sandboxed process via TCP and returns the answered message as a string. sendTo :: String         -- ^ Name of the registered port 

@@ -51,6 +51,7 @@ #else import System.Process hiding (env, waitForProcess) #endif+import qualified System.Process as P import System.Process.Internals (withProcessHandle, ProcessHandle__(OpenHandle)) import System.Random import System.Random.Shuffle@@ -121,6 +122,8 @@   , spPid :: Maybe ProcessID   , spPGid :: Maybe ProcessGroupID   , spHandles :: [Handle]+  , spEnvs :: Maybe [(String,String)]+  , spCwd :: Maybe FilePath   }  data Capture =@@ -175,10 +178,15 @@       -- Do not use these area for "userPorts" to avoid conflict.   newIORef $ SandboxState name dir M.empty [] M.empty availablePorts M.empty M.empty -registerProcess ::-  String -> FilePath -> [String] -> Maybe Int -> Maybe Capture-  -> Sandbox SandboxedProcess-registerProcess name bin args wait capture = do+registerProcess :: String                  -- ^ Process Name+                -> FilePath                -- ^ Path to the application binary+                -> [String]                -- ^ Arguments to pass on the command-line+                -> Maybe Int               -- ^ Time to wait (in s.) before checking that the process is still up+                -> Maybe Capture           -- ^ Which outputs to capture (if any)+                -> Maybe [(String,String)] -- ^ Evironment variables+                -> Maybe FilePath          -- ^ Working directory for the new process+                -> Sandbox SandboxedProcess+registerProcess name bin args wait capture process_env process_cwd = do   -- Validate process name   unless (isValidProcessName name) $     throwError $ "Invalid process name: " ++ name ++ "."@@ -186,7 +194,7 @@   env <- get   if isJust (M.lookup name (ssProcesses env)) then     throwError $ "Process " ++ name ++ " is already registered in the test environment."-    else do let sp = SandboxedProcess name bin args wait capture Nothing Nothing Nothing []+    else do let sp = SandboxedProcess name bin args wait capture Nothing Nothing Nothing [] process_env process_cwd             _ <- put env { ssProcesses = M.insert name sp (ssProcesses env)                          , ssProcessOrder = ssProcessOrder env ++ [name]                          }@@ -363,10 +371,13 @@               hde <- openFile filepath_e WriteMode               return (Nothing, UseHandle hdo, UseHandle hde, [hdo,hde])         Nothing -> return (Nothing, Inherit, Inherit, [])-      (Just ih, _, _, ph) <- liftIO $ createProcess $ (proc bin args) {create_group = True+      (Just ih, _, _, ph) <- liftIO $ createProcess $ (proc bin args) { create_group = True                                                                       , std_in = CreatePipe                                                                       , std_out = hOutRW-                                                                      , std_err = hErrRW }+                                                                      , std_err = hErrRW+                                                                      , cwd = spCwd sp+                                                                      , P.env = spEnvs sp+                                                                      }       when (isJust $ spWait sp) $ do         liftIO . threadDelay $ fromJust (spWait sp) * secondInµs       errno <- liftIO $ getProcessExitCode ph

@@ -1,5 +1,5 @@ Name:           test-sandbox-Version:        0.1.4+Version:        0.1.5 Cabal-Version:  >= 1.14 Category:       Testing Synopsis:       Sandbox for system tests@@ -28,7 +28,7 @@ Source-Repository this     Type:       git     Location:   https://github.com/gree/haskell-test-sandbox-    Tag:        test-sandbox_0.1.4+    Tag:        test-sandbox_0.1.5  Library     Exposed-modules:    Test.Sandbox