From 8db4f81e98184cd97fdffa538ce7aaaee4e816ae Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Sat, 28 Sep 2019 17:35:37 +0100 Subject: [PATCH 1/2] Paths: Move `findExecutable` to Test.Smoke.Paths. --- app/Test/Smoke/App/PrintErrors.hs | 19 +++++++++--------- src/Test/Smoke/Executable.hs | 32 ++++--------------------------- src/Test/Smoke/Filters.hs | 2 +- src/Test/Smoke/Paths.hs | 30 +++++++++++++++++++++++++++++ src/Test/Smoke/Plan.hs | 4 ++-- src/Test/Smoke/Types/Errors.hs | 13 +++---------- 6 files changed, 49 insertions(+), 51 deletions(-) diff --git a/app/Test/Smoke/App/PrintErrors.hs b/app/Test/Smoke/App/PrintErrors.hs index fc18fb9f..03a15fae 100644 --- a/app/Test/Smoke/App/PrintErrors.hs +++ b/app/Test/Smoke/App/PrintErrors.hs @@ -3,7 +3,7 @@ module Test.Smoke.App.PrintErrors ( printError , printDiscoveryError - , printExecutableError + , printPathError , printSuiteError , printTestError ) where @@ -13,12 +13,12 @@ import Data.String (fromString) import Data.Text (Text) import Test.Smoke import Test.Smoke.App.Print +import Test.Smoke.Paths printSuiteError :: SuiteError -> Output () printSuiteError (SuiteDiscoveryError discoveryError) = printDiscoveryError printError discoveryError -printSuiteError (SuiteExecutableError executableError) = - printExecutableError executableError +printSuiteError (SuitePathError pathError) = printPathError pathError printTestError :: SmokeError -> Output () printTestError (DiscoveryError discoveryError) = @@ -36,8 +36,8 @@ printTestError (PlanningError (CouldNotReadFixture path exception)) = "The fixture " <> showPath path <> " could not be read." printTestError (PlanningError (PlanningFilterError filterError)) = printFilterError filterError -printTestError (PlanningError (PlanningExecutableError executableError)) = - printExecutableError executableError +printTestError (PlanningError (PlanningPathError pathError)) = + printPathError pathError printTestError (ExecutionError (NonExistentWorkingDirectory (WorkingDirectory path))) = printError $ "The working directory " <> showPath path <> " does not exist." printTestError (ExecutionError (CouldNotExecuteCommand executable exception)) = @@ -105,13 +105,12 @@ printFilterError (ExecutionFailed executable (Status status) (StdOut stdOut) (St indentedAll messageIndentation stdOut <> "\nSTDERR:\n" <> indentedAll messageIndentation stdErr -printFilterError (FilterExecutableError executableError) = - printExecutableError executableError +printFilterError (FilterPathError pathError) = printPathError pathError -printExecutableError :: SmokeExecutableError -> Output () -printExecutableError (CouldNotFindExecutable path) = +printPathError :: PathError -> Output () +printPathError (CouldNotFindExecutable path) = printError $ "The executable " <> showPath path <> " could not be found." -printExecutableError (FileIsNotExecutable path) = +printPathError (FileIsNotExecutable path) = printError $ "The file at " <> showPath path <> " is not executable." printError :: Text -> Output () diff --git a/src/Test/Smoke/Executable.hs b/src/Test/Smoke/Executable.hs index 5e2b7a3f..81dd9fef 100644 --- a/src/Test/Smoke/Executable.hs +++ b/src/Test/Smoke/Executable.hs @@ -2,14 +2,10 @@ module Test.Smoke.Executable where -import Control.Monad (unless) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Except (ExceptT, throwE) +import Control.Monad.Trans.Except (ExceptT) import Data.Text (Text) import qualified Data.Text.IO as Text.IO import qualified Data.Vector as Vector -import Data.Vector (Vector) -import qualified System.Directory as Directory import System.Exit (ExitCode) import System.IO (hClose) import System.IO.Temp (withSystemTempFile) @@ -18,15 +14,12 @@ import System.Process.Text (readCreateProcessWithExitCode) import Test.Smoke.Paths import Test.Smoke.Types -defaultShell :: ExceptT SmokeExecutableError IO Shell +defaultShell :: ExceptT PathError IO Shell defaultShell = do sh <- findExecutable $ parseFile "sh" return $ Shell sh mempty -defaultShellExecute :: Vector String -defaultShellExecute = Vector.fromList ["sh", "-c"] - -shellFromCommandLine :: CommandLine -> ExceptT SmokeExecutableError IO Shell +shellFromCommandLine :: CommandLine -> ExceptT PathError IO Shell shellFromCommandLine (CommandLine shellName shellArgs) = do shellCommand <- findExecutable shellName return $ Shell shellCommand shellArgs @@ -56,7 +49,7 @@ runExecutable (ExecutableScript (Shell shellPath shellArgs) (Script script)) arg workingDirectory convertCommandToExecutable :: - Maybe Shell -> Command -> ExceptT SmokeExecutableError IO Executable + Maybe Shell -> Command -> ExceptT PathError IO Executable convertCommandToExecutable _ (CommandArgs (CommandLine executableName commandArgs)) = do executablePath <- findExecutable executableName return $ ExecutableProgram executablePath commandArgs @@ -68,20 +61,3 @@ convertCommandToExecutable (Just shell) (CommandScript Nothing script) = convertCommandToExecutable _ (CommandScript (Just commandLine) script) = do shell <- shellFromCommandLine commandLine return $ ExecutableScript shell script - -findExecutable :: - RelativePath File -> ExceptT SmokeExecutableError IO (ResolvedPath File) -findExecutable path = do - exists <- liftIO $ Directory.doesFileExist (toFilePath path) - if exists - then do - permissions <- liftIO $ Directory.getPermissions (toFilePath path) - unless (Directory.executable permissions) $ - throwE $ FileIsNotExecutable path - liftIO $ resolve path - else do - executable <- liftIO $ Directory.findExecutable (toFilePath path) - maybe - (throwE $ CouldNotFindExecutable path) - (liftIO . resolve . parseFile) - executable diff --git a/src/Test/Smoke/Filters.hs b/src/Test/Smoke/Filters.hs index 36f05d6c..8b917812 100644 --- a/src/Test/Smoke/Filters.hs +++ b/src/Test/Smoke/Filters.hs @@ -35,7 +35,7 @@ applyFiltersFromFixtures fallbackShell (Fixtures fixtures) value = runFilter :: FixtureType a => Maybe Shell -> Command -> a -> Filtering a runFilter fallbackShell command value = do executable <- - withExceptT FilterExecutableError $ + withExceptT FilterPathError $ convertCommandToExecutable fallbackShell command (exitCode, processStdOut, processStdErr) <- withExceptT (CouldNotExecuteFilter executable) $ diff --git a/src/Test/Smoke/Paths.hs b/src/Test/Smoke/Paths.hs index aa226336..70135989 100644 --- a/src/Test/Smoke/Paths.hs +++ b/src/Test/Smoke/Paths.hs @@ -8,7 +8,9 @@ module Test.Smoke.Paths , Path , RelativePath , ResolvedPath + , PathError(..) , () + , findExecutable , findFilesInPath , getCurrentWorkingDirectory , parent @@ -20,6 +22,10 @@ module Test.Smoke.Paths , writeToPath ) where +import Control.Exception (Exception) +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT, throwE) import Data.Aeson import Data.Text (Text) import qualified Data.Text as Text @@ -126,6 +132,22 @@ resolve path = do getCurrentWorkingDirectory :: IO (ResolvedPath Dir) getCurrentWorkingDirectory = ResolvedPath <$> Directory.getCurrentDirectory +findExecutable :: RelativePath File -> ExceptT PathError IO (ResolvedPath File) +findExecutable path = do + exists <- liftIO $ Directory.doesFileExist (toFilePath path) + if exists + then do + permissions <- liftIO $ Directory.getPermissions (toFilePath path) + unless (Directory.executable permissions) $ + throwE $ FileIsNotExecutable path + liftIO $ resolve path + else do + executable <- liftIO $ Directory.findExecutable (toFilePath path) + maybe + (throwE $ CouldNotFindExecutable path) + (liftIO . resolve . parseFile) + executable + -- Search findFilesInPath :: (Path p Dir, Path p File) => Glob.Pattern -> p Dir -> IO [p File] @@ -138,3 +160,11 @@ readFromPath = Text.IO.readFile . toFilePath writeToPath :: ResolvedPath File -> Text -> IO () writeToPath = Text.IO.writeFile . toFilePath + +-- Errors +data PathError + = CouldNotFindExecutable (RelativePath File) + | FileIsNotExecutable (RelativePath File) + deriving (Eq, Show) + +instance Exception PathError diff --git a/src/Test/Smoke/Plan.hs b/src/Test/Smoke/Plan.hs index f95b5c4b..c3a5dede 100644 --- a/src/Test/Smoke/Plan.hs +++ b/src/Test/Smoke/Plan.hs @@ -32,7 +32,7 @@ planTests (TestSpecification specificationCommand suites) = do runExceptT $ mapM shellFromCommandLine thisSuiteShellCommandLine case shell of Left exception -> - return $ SuitePlanError suiteName $ SuiteExecutableError exception + return $ SuitePlanError suiteName $ SuitePathError exception Right fallbackShell -> do let fallbackWorkingDirectory = fromMaybe currentWorkingDirectory thisSuiteWorkingDirectory @@ -74,7 +74,7 @@ readTest location fallbackWorkingDirectory fallbackShell fallbackCommand test = command <- maybe (throwE NoCommand) return (testCommand test <|> fallbackCommand) executable <- - withExceptT PlanningExecutableError $ + withExceptT PlanningPathError $ convertCommandToExecutable fallbackShell command let args = fromMaybe mempty (testArgs test) unfilteredStdIn <- diff --git a/src/Test/Smoke/Types/Errors.hs b/src/Test/Smoke/Types/Errors.hs index 2f72af43..9277b66a 100644 --- a/src/Test/Smoke/Types/Errors.hs +++ b/src/Test/Smoke/Types/Errors.hs @@ -31,7 +31,7 @@ data SmokePlanningError | NoOutput | NonExistentFixture (RelativePath File) | CouldNotReadFixture (RelativePath File) IOError - | PlanningExecutableError SmokeExecutableError + | PlanningPathError PathError | PlanningFilterError SmokeFilterError deriving (Eq, Show) @@ -61,19 +61,12 @@ data SmokeFilterError = MissingFilterScript | CouldNotExecuteFilter Executable IOError | ExecutionFailed Executable Status StdOut StdErr - | FilterExecutableError SmokeExecutableError + | FilterPathError PathError deriving (Eq, Show) instance Exception SmokeFilterError -data SmokeExecutableError - = CouldNotFindExecutable (RelativePath File) - | FileIsNotExecutable (RelativePath File) - deriving (Eq, Show) - -instance Exception SmokeExecutableError - data SuiteError = SuiteDiscoveryError SmokeDiscoveryError - | SuiteExecutableError SmokeExecutableError + | SuitePathError PathError deriving (Eq, Show) From 17c587494f5d2d051ba23ea3af07b39a8892b467 Mon Sep 17 00:00:00 2001 From: Samir Talwar Date: Sat, 28 Sep 2019 18:34:53 +0100 Subject: [PATCH 2/2] Shell: Use "cmd /q /c" on Windows, not "sh". --- fixtures/broken-specs/smoke.yaml | 12 ++++-------- fixtures/shell/local.yaml | 10 +++++----- package.yaml | 8 ++++++++ spec/io/shell.out-unix | 6 +++--- spec/io/shell.out-windows | 17 ++++++++++++----- src/Test/Smoke/Executable.hs | 20 +++++++------------- src/unix/Test/Smoke/Shell.hs | 13 +++++++++++++ src/windows/Test/Smoke/Shell.hs | 15 +++++++++++++++ 8 files changed, 67 insertions(+), 34 deletions(-) create mode 100644 src/unix/Test/Smoke/Shell.hs create mode 100644 src/windows/Test/Smoke/Shell.hs diff --git a/fixtures/broken-specs/smoke.yaml b/fixtures/broken-specs/smoke.yaml index 86513379..ce0c0ccb 100644 --- a/fixtures/broken-specs/smoke.yaml +++ b/fixtures/broken-specs/smoke.yaml @@ -2,14 +2,12 @@ tests: - name: no-command - name: no-outputs - command: - - echo + command: echo args: - input - name: missing-input-file - command: - - echo + command: echo args: - something stdin: @@ -18,16 +16,14 @@ tests: output - name: missing-output-file - command: - - echo + command: echo args: - something stdout: file: io/missing.out - name: missing-error-file - command: - - echo + command: echo args: - something stderr: diff --git a/fixtures/shell/local.yaml b/fixtures/shell/local.yaml index 2d73c710..3ed80706 100644 --- a/fixtures/shell/local.yaml +++ b/fixtures/shell/local.yaml @@ -1,9 +1,9 @@ tests: - - name: use the default shell + - name: use the default shell, on Unix or Windows command: | - echo 'Something.' >&2 + echo Something.>&2 false - echo 'Something else.' >&2 + echo Something else.>&2 stderr: | Something. Something else. @@ -41,7 +41,7 @@ tests: stderr: | Something else. - - name: pass args to a shell command + - name: pass args to the default shell command command: | echo $1 $2 $3 args: @@ -53,7 +53,7 @@ tests: stdout: | a b c - - name: pass args to a shell command with a custom shell + - name: pass args to a custom shell command command: shell: - ruby diff --git a/package.yaml b/package.yaml index aea2675e..a42017e6 100644 --- a/package.yaml +++ b/package.yaml @@ -40,6 +40,14 @@ library: ghc-options: - -Wall - -Werror + when: + condition: os(windows) + then: + source-dirs: + - src/windows + else: + source-dirs: + - src/unix executables: smoke: diff --git a/spec/io/shell.out-unix b/spec/io/shell.out-unix index c912f531..8ff190cf 100644 --- a/spec/io/shell.out-unix +++ b/spec/io/shell.out-unix @@ -2,7 +2,7 @@ global/runs the command with a custom shell succeeded global/runs the filter with a custom shell succeeded -local/use the default shell +local/use the default shell, on Unix or Windows succeeded local/pipe STDIN to the script succeeded @@ -10,9 +10,9 @@ local/use custom shell flags succeeded local/use a custom shell succeeded -local/pass args to a shell command +local/pass args to the default shell command succeeded -local/pass args to a shell command with a custom shell +local/pass args to a custom shell command succeeded local/use a custom shell with an absolute path succeeded diff --git a/spec/io/shell.out-windows b/spec/io/shell.out-windows index 9650f8ee..fa4497a7 100644 --- a/spec/io/shell.out-windows +++ b/spec/io/shell.out-windows @@ -2,7 +2,7 @@ global/runs the command with a custom shell succeeded global/runs the filter with a custom shell succeeded -local/use the default shell +local/use the default shell, on Unix or Windows succeeded local/pipe STDIN to the script succeeded @@ -10,9 +10,16 @@ local/use custom shell flags succeeded local/use a custom shell succeeded -local/pass args to a shell command - succeeded -local/pass args to a shell command with a custom shell +local/pass args to the default shell command + args: a + b + c + d + e + stdout: @@ -1 +1 @@ + -a b c + +$1 $2 $3 +local/pass args to a custom shell command succeeded local/use a custom shell with an absolute path The executable "bin\sh" could not be found. @@ -21,4 +28,4 @@ local/use a shell that doesn't exist local/use a shell that isn't executable The file at "fixtures\non_executable_application" is not executable. -11 tests, 3 failures +11 tests, 4 failures diff --git a/src/Test/Smoke/Executable.hs b/src/Test/Smoke/Executable.hs index 81dd9fef..5c16701b 100644 --- a/src/Test/Smoke/Executable.hs +++ b/src/Test/Smoke/Executable.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Test.Smoke.Executable where import Control.Monad.Trans.Except (ExceptT) @@ -12,18 +10,9 @@ import System.IO.Temp (withSystemTempFile) import System.Process (CreateProcess(..), proc) import System.Process.Text (readCreateProcessWithExitCode) import Test.Smoke.Paths +import Test.Smoke.Shell import Test.Smoke.Types -defaultShell :: ExceptT PathError IO Shell -defaultShell = do - sh <- findExecutable $ parseFile "sh" - return $ Shell sh mempty - -shellFromCommandLine :: CommandLine -> ExceptT PathError IO Shell -shellFromCommandLine (CommandLine shellName shellArgs) = do - shellCommand <- findExecutable shellName - return $ Shell shellCommand shellArgs - runExecutable :: Executable -> Args @@ -38,7 +27,7 @@ runExecutable (ExecutableProgram executablePath executableArgs) args (StdIn stdI {cwd = toFilePath . unWorkingDirectory <$> workingDirectory}) stdIn runExecutable (ExecutableScript (Shell shellPath shellArgs) (Script script)) args stdIn workingDirectory = - withSystemTempFile "smoke.sh" $ \scriptPath scriptHandle -> do + withSystemTempFile defaultShellScriptName $ \scriptPath scriptHandle -> do Text.IO.hPutStr scriptHandle script hClose scriptHandle let executableArgs = shellArgs <> Args (Vector.singleton scriptPath) @@ -61,3 +50,8 @@ convertCommandToExecutable (Just shell) (CommandScript Nothing script) = convertCommandToExecutable _ (CommandScript (Just commandLine) script) = do shell <- shellFromCommandLine commandLine return $ ExecutableScript shell script + +shellFromCommandLine :: CommandLine -> ExceptT PathError IO Shell +shellFromCommandLine (CommandLine shellName shellArgs) = do + shellCommand <- findExecutable shellName + return $ Shell shellCommand shellArgs diff --git a/src/unix/Test/Smoke/Shell.hs b/src/unix/Test/Smoke/Shell.hs new file mode 100644 index 00000000..5828158d --- /dev/null +++ b/src/unix/Test/Smoke/Shell.hs @@ -0,0 +1,13 @@ +module Test.Smoke.Shell where + +import Control.Monad.Trans.Except (ExceptT) +import Test.Smoke.Paths +import Test.Smoke.Types + +defaultShellScriptName :: String +defaultShellScriptName = "smoke.sh" + +defaultShell :: ExceptT PathError IO Shell +defaultShell = do + sh <- findExecutable $ parseFile "sh" + return $ Shell sh mempty diff --git a/src/windows/Test/Smoke/Shell.hs b/src/windows/Test/Smoke/Shell.hs new file mode 100644 index 00000000..67795b76 --- /dev/null +++ b/src/windows/Test/Smoke/Shell.hs @@ -0,0 +1,15 @@ +module Test.Smoke.Shell where + +import Control.Monad.Trans.Except (ExceptT) +import qualified Data.Vector as Vector +import Test.Smoke.Paths +import Test.Smoke.Types + +defaultShellScriptName :: String +defaultShellScriptName = "smoke.bat" + +defaultShell :: ExceptT PathError IO Shell +defaultShell = do + cmd <- findExecutable $ parseFile "cmd" + let args = Args (Vector.fromList ["/q", "/c"]) + return $ Shell cmd args