Rename some process running utilities
diff --git a/test/Test.hs b/test/Test.hs
index 7d084c7..81c1534 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -22,7 +22,7 @@
prop_args args = do
c <- command "x" $ "dumpargs" : map unarg args
return $ monadicIO $ do
- mout <- run $ outputFrom c
+ mout <- run $ systemStdout c
assert $ case mout of
Just out -> args == (Arg <$> read (head $ lines out))
Nothing -> False
@@ -81,8 +81,8 @@
rvalid = sort . filter (valid t) . map (R . Path)
e = Env {shellMode = sm, tmpDir = t, pwdDir = pwd}
qc s p = noisy s >> quickCheckWithResult (stdArgs {maxSuccess=1}) (runReader p e)
- _ <- outputFrom ["cp", "-R", src, tsrc]
- deps <- outputFrom ["gcc", "-MM", unpath emitc]
+ _ <- systemStdout ["cp", "-R", src, tsrc]
+ deps <- systemStdout ["gcc", "-MM", unpath emitc]
ndeps <- mapM canonicalizePath (parseMakefileDeps deps)
cldeps <- if hascl then errorFrom ["cl", "/nologo", "/showIncludes", "/E", "/DPATH_MAX=4096", unpath clcsrc] else return []
ncldeps <- if hascl then mapM canonicalizePath (unpath clcsrc : parseClDeps cldeps) else return []
diff --git a/test/Utils.hs b/test/Utils.hs
index bfc1be3..376b88f 100644
--- a/test/Utils.hs
+++ b/test/Utils.hs
@@ -6,17 +6,19 @@
Path(..), Arg(..),
cased, valid,
command, yields,
- outputFrom
+ systemStdout, systemStderr
) where
import Parse
import Control.Monad
+import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Char
import Data.List.Extra
import Data.Maybe
import System.Exit
+import System.IO
import System.Process
import System.FilePath
import System.Info.Extra
@@ -74,19 +76,12 @@
inTmp t = isPrefixOf (cased t) . cased . unpath
-parsedOutputFrom :: [String] -> IO (Maybe [Access Path])
-parsedOutputFrom x = do
- mout <- outputFrom x
- return $ case mout of
- Just out -> Just $ map (fmap Path) $ parseFSATrace out
- Nothing -> Nothing
-
yields :: Reader Env [String] -> [Access Path] -> Prop
yields eargs res = do
e <- ask
return $ monadicIO $ do
- let args = runReader eargs e
- r <- run $ parsedOutputFrom args
+ out <- liftIO $ systemStdout $ runReader eargs e
+ let r = fmap (map (fmap Path) . parseFSATrace) out
let sr | isJust r = Just $ nubSort $ filter (valid $ tmpDir e) $ fromJust r
| otherwise = Nothing
ok = sr == Just res
@@ -109,9 +104,14 @@
quoted ">" = ">"
quoted x = "\"" ++ x ++ "\""
-outputFrom :: [String] -> IO (Maybe String)
-outputFrom (cmd:args) = do
- (rc,out,err) <- readProcessWithExitCode cmd args ""
- when (err /= "") $ putStrLn err
- return $ if rc == ExitSuccess then Just out else Nothing
-outputFrom _ = undefined
+
+systemStderr :: [String] -> IO (Maybe String)
+systemStderr (cmd:args) = do
+ (res,out,err) <- readProcessWithExitCode cmd args ""
+ return $ if res == ExitSuccess then Just err else Nothing
+
+systemStdout :: [String] -> IO (Maybe String)
+systemStdout (cmd:args) = do
+ (res,out,err) <- readProcessWithExitCode cmd args ""
+ when (err /= "") $ hPutStrLn stderr err
+ return $ if res == ExitSuccess then Just out else Nothing