Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

test to verify the executable can provide a version string on -v|--ve…

…rsion
  • Loading branch information...
commit 93cb93d8bbe8e6df8517f72042032c1959ae199e 1 parent 1814e00
@coreyoconnor coreyoconnor authored
Showing with 115 additions and 28 deletions.
  1. +19 −17 src/executable/Main.hs
  2. +86 −10 test/VerifyManagementProcess.hs
  3. +10 −1 yi.cabal
View
36 src/executable/Main.hs
@@ -1,5 +1,3 @@
--- Copyright (C) 2008 JP Bernardy
--- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (C) 2012 Corey O'Connor
--
-- | This process manages the compilation and execution of yi.
@@ -8,14 +6,17 @@
-- final states are process termination.
--
-module Main (main) where
+module Main (main, main_) where
import Prelude hiding ( catch )
+import Paths_yi
+
import Control.Applicative
import Control.Exception
import System.Directory
+import System.Environment
import System.Exit
import System.IO
@@ -28,30 +29,31 @@ info :: HPrintfType r => String -> r
info format = hPrintf stderr format
data YiSystem where
- Init :: YiSystem
+ -- Initial state. Parameterized by command line arguments.
+ Init :: [String] -> YiSystem
Die :: Int -> String -> YiSystem
Exit :: YiSystem
-data SystemConfig where
- SystemConfig ::
- { hasUserConfig :: Bool
- } -> SystemConfig
- deriving ( Show, Eq, Read )
-
main :: IO ()
-main = catch (manageYiSystem Init) dieFromException
+main = do
+ exit_code <- main_ =<< getArgs
+ exitWith exit_code
+
+main_ :: [String] -> IO ExitCode
+main_ args = catch (manageYiSystem $ Init args) dieFromException
-dieFromException :: SomeException -> IO a
+dieFromException :: SomeException -> IO ExitCode
dieFromException e = manageYiSystem (Die 1 $ show e)
-manageYiSystem :: YiSystem -> IO a
+manageYiSystem :: YiSystem -> IO ExitCode
manageYiSystem (Die n reason) = do
info "E%d - %s" n reason
- exitWith $ ExitFailure n
+ return $ ExitFailure n
manageYiSystem Exit = do
- exitWith ExitSuccess
-manageYiSystem Init = do
- -- Determine what we know about the Yi system
+ return ExitSuccess
+manageYiSystem (Init args) = do
+ -- Examine the command line arguments to determine if any actions need to be taken before
+ -- booting yi proper.
user_dir_exists <- doesDirectoryExist <$> appDir
manageYiSystem Exit
View
96 test/VerifyManagementProcess.hs
@@ -1,16 +1,92 @@
+{-# LANGUAGE FlexibleContexts #-}
module VerifyManagementProcess where
+import Prelude hiding ( concat )
+
import Distribution.TestSuite
+import Main
+
+import Paths_yi
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Monad ( when )
+import Control.Monad.Error hiding ( forM_ )
+
+import Data.Either
+import Data.Foldable
+import Data.Maybe
+
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+
+import Text.Printf
+import Text.Regex.Posix
+
+info f = do
+ hPrintf stderr (if last f == '\n' then f else f ++ "\n")
+ hFlush stderr
+
+-- TODO(corey): I'm suspect of the plan here.
+-- # create new handles for stdout and stderr
+-- # spawn the yi process
+-- # spawn threads to write to stdin from a string
+-- # get the contents lazily of stdout and stderr
+-- # wait on the process to end
+str_interact_yi :: [String] -> String -> IO (String, String, ExitCode)
+str_interact_yi args stdin_str = do
+ let yi_exe_path = "dist/build/yi/yi"
+ let cmd = RawCommand yi_exe_path args
+ process_spec = CreateProcess
+ { cmdspec = cmd
+ , cwd = Nothing
+ , env = Nothing
+ , std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ , close_fds = False
+ , create_group = True
+ }
+ (Just stdin_h, Just stdout_h, Just stderr_h, process) <- createProcess process_spec
+ forM_ [stdin_h, stdout_h, stderr_h] (flip hSetBuffering NoBuffering)
+ forkIO $ hPutStr stdin_h stdin_str >> hClose stdin_h
+ stdout_str <- hGetContents stdout_h
+ stderr_str <- hGetContents stderr_h
+ exit_code <- waitForProcess process
+ info $ printf "%s - yi %s" (show exit_code) (concat args)
+ return (stdout_str, stderr_str, exit_code)
+
tests :: IO [Test]
-tests = return [ verify_boot_transition ]
-
-verify_boot_transition :: Test
-verify_boot_transition = Test $ TestInstance
- { run = return $ Finished Pass
- , name = "verify boot transition"
- , tags = []
- , options = []
- , setOption = const (const $ Left "no options")
- }
+tests = return $ concat [ verify_v_opts ]
+
+assert :: (MonadError String m, Monad m) => Bool -> String -> m ()
+assert b f_str = when (not b) (throwError f_str)
+
+verify_v_opts :: [Test]
+verify_v_opts = foldMap tests_for_version_opt ["-v", "--version"]
+ where
+ tests_for_version_opt v_opt =
+ [ Test $ TestInstance
+ { run = do
+ let expected = "^master version: (.*)$"
+ (stdout_str, stderr_str, exit_code) <- str_interact_yi [v_opt] ""
+ info $ "stdout -\n" ++ stderr_str
+ let r = do
+ assert (exit_code == ExitSuccess)
+ $ "yi failed - " ++ show exit_code
+ assert (stdout_str =~ expected)
+ $ "stdout did not state master version -\n" ++ stdout_str
+ info $ show r
+ return $ Finished $ case r of
+ Right () -> Pass
+ Left f_msg -> Fail f_msg
+ , name = v_opt ++ " outputs version info"
+ , tags = []
+ , options = []
+ , setOption = const (const $ Left "no options")
+ }
+ ]
View
11 yi.cabal
@@ -20,9 +20,13 @@ executable yi
default-language: Haskell2010
default-extensions: GADTs
main-is: Main.hs
+ other-modules: Paths_yi
build-depends:
base >=4 && <5,
directory >= 1 && < 2,
+ filepath == 1.*,
+ mtl == 2.*,
+ process == 1.*,
Cabal >= 1.14.0
ghc-options: -threaded
@@ -30,10 +34,15 @@ test-suite verify-management-process
type: detailed-0.9
hs-source-dirs: src/executable src/library test/
test-module: VerifyManagementProcess
+ other-modules: Paths_yi
default-language: Haskell2010
default-extensions: GADTs
build-depends:
base >=4 && <5,
directory >= 1 && < 2,
- Cabal >= 1.14.0
+ filepath == 1.*,
+ mtl == 2.*,
+ process == 1.*,
+ Cabal >= 1.14.0,
+ regex-posix >= 0.95.1
ghc-options: -threaded
Please sign in to comment.
Something went wrong with that request. Please try again.