When running the shell on Windows, use cmd as the default. (#26)

When running the shell on Windows, use `cmd` as the default.

Author: SamirTalwar

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 ()

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:

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

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:

spec/io/shell.out-unix

@@ -2,17 +2,17 @@ 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
 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

spec/io/shell.out-windows

@@ -2,17 +2,24 @@ 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
 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

src/Test/Smoke/Executable.hs

@@ -1,36 +1,18 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 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)
 import System.Process (CreateProcess(..), proc)
 import System.Process.Text (readCreateProcessWithExitCode)
 import Test.Smoke.Paths
+import Test.Smoke.Shell
 import Test.Smoke.Types
 
-defaultShell :: ExceptT SmokeExecutableError 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 shellName shellArgs) = do
-  shellCommand <- findExecutable shellName
-  return $ Shell shellCommand shellArgs
-
 runExecutable ::
      Executable
   -> Args
@@ -45,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)
@@ -56,7 +38,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
@@ -69,19 +51,7 @@ 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
+shellFromCommandLine :: CommandLine -> ExceptT PathError IO Shell
+shellFromCommandLine (CommandLine shellName shellArgs) = do
+  shellCommand <- findExecutable shellName
+  return $ Shell shellCommand shellArgs

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) $

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

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 <-