Add support for environment variables

README.md

@@ -216,6 +216,28 @@ You can find more examples in the [local shell fixture][] and [global shell fixt
 [local shell fixture]: ./fixtures/shell/local.yaml
 [global shell fixture]: ./fixtures/shell/global.yaml
 
+### Setting environment variables
+
+It is possible to set environment variables, both as defaults for a suite, and for a specific test. Environment variables inherit from the suite, and the suite inherits from the environment `smoke` is started in.
+
+```yaml
+environment:
+  CI: "0"
+
+tests:
+  - name:
+    environment:
+      CI: "1"
+    command: echo ${CI}
+    stdout: |
+      1
+```
+
+You can find more examples in the [environment fixture][].
+
+[environment fixture]: ./fixtures/environment/smoke.yaml
+
+
 ### Filtering output
 
 Sometimes, things aren't quite so deterministic. When some of the output (or input) is meaningless, or if there's just too much, you can specify filters to transform the data.

fixtures/environment.rb

@@ -0,0 +1 @@
+ARGV.each { |arg| puts ENV[arg] }

fixtures/environment/smoke.yaml

@@ -0,0 +1,57 @@
+command:
+  - ruby
+  - fixtures/environment.rb
+
+environment:
+  ONLY_DEFINED_IN_FIXTURE_DEFAULT: "defined_in_fixture_default"
+  OVERWRITTEN_IN_FIXTURE_FROM_DEFAULT: "not_overwritten"
+
+tests:
+  - name: environment
+    environment:
+      TEST_ENV: "test-value"
+    args:
+      - TEST_ENV
+    stdout: |
+      test-value
+
+  - name: inherits
+    args:
+      - ONLY_DEFINED_IN_SPEC
+      - ONLY_DEFINED_IN_FIXTURE_DEFAULT
+    stdout: |
+      defined_in_spec
+      defined_in_fixture_default
+
+  - name: overwrites
+    environment:
+      OVERWRITE_IN_FIXTURE: "overwritten"
+    args:
+      - OVERWRITE_IN_FIXTURE
+    stdout: |
+      overwritten
+
+  - name: overwrites-from-default
+    environment:
+      OVERWRITTEN_IN_FIXTURE_FROM_DEFAULT: "overwritten"
+    args:
+      - OVERWRITTEN_IN_FIXTURE_FROM_DEFAULT
+    stdout: |
+      overwritten
+
+  - name: not-defined
+    args:
+      - NOT_DEFINED
+    stdout: "\n"
+
+  - name: spec-is-merged-into-fixture-not-replaced
+    environment:
+      OVERWRITE_IN_FIXTURE: "overwritten"
+    args:
+      - OVERWRITE_IN_FIXTURE
+      - ONLY_DEFINED_IN_SPEC
+      - ONLY_DEFINED_IN_FIXTURE_DEFAULT
+    stdout: |
+      overwritten
+      defined_in_spec
+      defined_in_fixture_default

spec/environment.yaml

@@ -0,0 +1,10 @@
+tests:
+  - name: environment
+    args:
+      - fixtures/environment/smoke.yaml
+    exit-code: 0
+    environment:
+      OVERWRITE_IN_FIXTURE: "not_overwritten"
+      ONLY_DEFINED_IN_SPEC: "defined_in_spec"
+    stdout:
+      - file: io/environment.out

spec/io/environment.out

@@ -0,0 +1,14 @@
+environment
+  succeeded
+inherits
+  succeeded
+overwrites
+  succeeded
+overwrites-from-default
+  succeeded
+not-defined
+  succeeded
+spec-is-merged-into-fixture-not-replaced
+  succeeded
+
+6 tests, 0 failures

src/lib/Test/Smoke/Assert.hs

@@ -23,7 +23,7 @@ assertResult location testPlan@TestPlan {planTest = test} (ExecutionSucceeded ac
   either (TestErrored test . AssertionError) (TestFinished testPlan) <$> runExceptT (processOutputs location testPlan actualOutputs)
 
 processOutputs :: Path Resolved Dir -> TestPlan -> ActualOutputs -> Asserting FinishedTest
-processOutputs location (TestPlan _ _ fallbackShell _ _ _ expectedStatus expectedStdOuts expectedStdErrs expectedFiles _) (ActualOutputs actualStatus actualStdOut actualStdErr actualFiles) = do
+processOutputs location (TestPlan _ _ fallbackShell _ _ _ _ expectedStatus expectedStdOuts expectedStdErrs expectedFiles _) (ActualOutputs actualStatus actualStdOut actualStdErr actualFiles) = do
   let statusResult = assertEqual expectedStatus actualStatus
   stdOutResult <- assertAll (defaultIfEmpty expectedStdOuts) actualStdOut
   stdErrResult <- assertAll (defaultIfEmpty expectedStdErrs) actualStdErr

src/lib/Test/Smoke/Executable.hs

@@ -1,9 +1,11 @@
 module Test.Smoke.Executable where
 
 import Control.Monad.Trans.Except (ExceptT)
+import Data.Map.Strict qualified as Map
 import Data.Text (Text)
 import Data.Text.IO qualified as Text.IO
 import Data.Vector qualified as Vector
+import System.Environment (getEnvironment)
 import System.Exit (ExitCode)
 import System.IO (hClose)
 import System.IO.Temp (withSystemTempFile)
@@ -17,19 +19,27 @@ runExecutable ::
   Executable ->
   Args ->
   StdIn ->
+  Maybe EnvVars ->
   Maybe WorkingDirectory ->
   IO (ExitCode, Text, Text)
-runExecutable (ExecutableProgram executablePath executableArgs) args (StdIn stdIn) workingDirectory =
+runExecutable (ExecutableProgram executablePath executableArgs) args (StdIn stdIn) env workingDirectory = do
+  mergedEnv <- traverse addOriginalEnv env
   readCreateProcessWithExitCode
     ( ( proc
           (toFilePath executablePath)
           (Vector.toList (unArgs (executableArgs <> args)))
       )
-        { cwd = toFilePath . unWorkingDirectory <$> workingDirectory
+        { cwd = toFilePath . unWorkingDirectory <$> workingDirectory,
+          env = Map.toList . unEnvVars <$> mergedEnv
         }
     )
     stdIn
-runExecutable (ExecutableScript (Shell shellPath shellArgs) (Script script)) args stdIn workingDirectory =
+  where
+    addOriginalEnv :: EnvVars -> IO EnvVars
+    addOriginalEnv overriddenEnv = do
+      originalEnv <- EnvVars . Map.fromList <$> getEnvironment
+      pure $ overriddenEnv <> originalEnv
+runExecutable (ExecutableScript (Shell shellPath shellArgs) (Script script)) args stdIn env workingDirectory =
   withSystemTempFile defaultShellScriptName $ \scriptPath scriptHandle -> do
     Text.IO.hPutStr scriptHandle script
     hClose scriptHandle
@@ -38,6 +48,7 @@ runExecutable (ExecutableScript (Shell shellPath shellArgs) (Script script)) arg
       (ExecutableProgram shellPath executableArgs)
       args
       stdIn
+      env
       workingDirectory
 
 convertCommandToExecutable ::

src/lib/Test/Smoke/Execution.hs

@@ -31,7 +31,7 @@ runTest location testPlan =
     else either ExecutionFailed ExecutionSucceeded <$> runExceptT (executeTest location testPlan)
 
 executeTest :: Path Resolved Dir -> TestPlan -> Execution ActualOutputs
-executeTest location (TestPlan _ workingDirectory _ executable args processStdIn _ _ _ files revert) = do
+executeTest location (TestPlan _ workingDirectory _ executable args env processStdIn _ _ _ files revert) = do
   let workingDirectoryFilePath =
         toFilePath $ unWorkingDirectory workingDirectory
   workingDirectoryExists <- liftIO $ doesDirectoryExist workingDirectoryFilePath
@@ -41,7 +41,7 @@ executeTest location (TestPlan _ workingDirectory _ executable args processStdIn
   revertingDirectories revert $ do
     (exitCode, processStdOut, processStdErr) <-
       tryIO (CouldNotExecuteCommand executable) $
-        runExecutable executable args processStdIn (Just workingDirectory)
+        runExecutable executable args processStdIn env (Just workingDirectory)
     actualFiles <- Map.fromList <$> mapM (liftIO . readTestFile) (Map.keys files)
     pure $ ActualOutputs (convertExitCode exitCode) (StdOut processStdOut) (StdErr processStdErr) actualFiles
   where

src/lib/Test/Smoke/Filters.hs

@@ -17,7 +17,7 @@ applyFilters fallbackShell (Filter command) value = do
     withExceptT (CouldNotExecuteFilter executable) $
       ExceptT $
         tryIOError $
-          runExecutable executable mempty (StdIn (serializeFixture value)) Nothing
+          runExecutable executable mempty (StdIn (serializeFixture value)) Nothing Nothing
   case exitCode of
     ExitSuccess -> pure $ deserializeFixture processStdOut
     ExitFailure code ->

src/lib/Test/Smoke/Plan.hs

@@ -25,7 +25,7 @@ planTests :: TestSpecification -> IO Plan
 planTests (TestSpecification specificationCommand suites) = do
   currentWorkingDirectory <- WorkingDirectory <$> getCurrentWorkingDirectory
   suitePlans <-
-    forM suites $ \(SuiteWithMetadata suiteName location (Suite thisSuiteWorkingDirectory thisSuiteShellCommandLine thisSuiteCommand tests)) -> do
+    forM suites $ \(SuiteWithMetadata suiteName location (Suite thisSuiteWorkingDirectory thisSuiteShellCommandLine thisSuiteCommand thisSuiteEnvVars tests)) -> do
       let fallbackCommand = thisSuiteCommand <|> specificationCommand
       shell <-
         runExceptT $ mapM shellFromCommandLine thisSuiteShellCommandLine
@@ -45,6 +45,7 @@ planTests (TestSpecification specificationCommand suites) = do
                         fallbackWorkingDirectory
                         fallbackShell
                         fallbackCommand
+                        thisSuiteEnvVars
                         test
                   )
           pure $ SuitePlan suiteName location testPlans
@@ -62,9 +63,10 @@ readTest ::
   WorkingDirectory ->
   Maybe Shell ->
   Maybe Command ->
+  Maybe EnvVars ->
   Test ->
   Planning TestPlan
-readTest location fallbackWorkingDirectory fallbackShell fallbackCommand test = do
+readTest location fallbackWorkingDirectory fallbackShell fallbackCommand fallbackEnvironment test = do
   let workingDirectory = determineWorkingDirectory location (testWorkingDirectory test) fallbackWorkingDirectory
   command <-
     maybe (throwE NoCommand) pure (testCommand test <|> fallbackCommand)
@@ -85,6 +87,7 @@ readTest location fallbackWorkingDirectory fallbackShell fallbackCommand test =
         planShell = fallbackShell,
         planExecutable = executable,
         planArgs = args,
+        planEnvironment = testEnvironment test <> fallbackEnvironment,
         planStdIn = stdIn,
         planStatus = status,
         planStdOut = stdOut,

src/lib/Test/Smoke/Types/Base.hs

@@ -8,6 +8,7 @@ import Control.Monad (when)
 import Data.Aeson
 import Data.Aeson.Types (Parser, typeMismatch)
 import Data.Default
+import Data.Map.Strict (Map)
 import Data.String (IsString)
 import Data.Text (Text)
 import Data.Text qualified as Text
@@ -55,6 +56,11 @@ instance FromFixture Args where
   fixtureName = "args"
   serializeFixture = Text.unlines . Vector.toList . Vector.map Text.pack . unArgs
 
+newtype EnvVars = EnvVars
+  { unEnvVars :: Map String String
+  }
+  deriving (Semigroup, FromJSON)
+
 newtype Script = Script
   { unScript :: Text
   }

src/lib/Test/Smoke/Types/Plans.hs

@@ -26,6 +26,7 @@ data TestPlan = TestPlan
     planShell :: Maybe Shell,
     planExecutable :: Executable,
     planArgs :: Args,
+    planEnvironment :: Maybe EnvVars,
     planStdIn :: StdIn,
     planStatus :: Status,
     planStdOut :: Vector (Assert StdOut),

src/lib/Test/Smoke/Types/Tests.hs

@@ -27,6 +27,7 @@ data Suite = Suite
   { suiteWorkingDirectory :: Maybe (Path Relative Dir),
     suiteShell :: Maybe CommandLine,
     suiteCommand :: Maybe Command,
+    suiteEnvironment :: Maybe EnvVars,
     suiteTests :: [Test]
   }
 
@@ -37,6 +38,7 @@ instance FromJSON Suite where
         <$> (v .:? "working-directory")
         <*> (v .:? "shell")
         <*> (v .:? "command")
+        <*> (v .:? "environment")
         <*> (v .: "tests")
 
 data Test = Test
@@ -45,6 +47,7 @@ data Test = Test
     testWorkingDirectory :: Maybe (Path Relative Dir),
     testCommand :: Maybe Command,
     testArgs :: Maybe Args,
+    testEnvironment :: Maybe EnvVars,
     testStdIn :: Maybe (TestInput StdIn),
     testStatus :: Status,
     testStdOut :: Vector (TestOutput StdOut),
@@ -62,6 +65,7 @@ instance FromJSON Test where
         <*> (v .:? "working-directory")
         <*> (v .:? "command")
         <*> (v .:? "args")
+        <*> (v .:? "environment")
         <*> (v .:? "stdin")
         <*> (v .:? "exit-status" .!= def)
         <*> (manyMaybe <$> (v .:? "stdout"))