diff --git a/ChangeLog.md b/ChangeLog.md index ebdcaa4cb5..faec00da42 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -25,6 +25,12 @@ Behavior changes: [Haskell Error Index](https://errors.haskell.org/) initiative, all Stack error messages generated by Stack itself begin with an unique code in the form `[S-nnnn]`, where `nnnn` is a four-digit number. +* Test suite executables that seek input on the standard input channel (`stdin`) + will not throw an exception. Previously, they would thow an exception, + consistent with Cabal's 'exitcode-stdio-1.0' test suite interface + specification. Pass the flag `--no-tests-allow-stdin` to `stack build` to + enforce Cabal's specification. See + [#5897](https://github.com/commercialhaskell/stack/issues/5897) Other enhancements: diff --git a/doc/build_command.md b/doc/build_command.md index 2b5be01710..21ad8add88 100644 --- a/doc/build_command.md +++ b/doc/build_command.md @@ -329,6 +329,20 @@ Pass the flag to build your project with the GHC options `-Wall` and `-Werror`. Pass the flag to rebuild your project every time any local file changes (from project packages or from local dependencies). See also the `--file-watch` flag. +### The `stack build --tests-allow-stdin` flag + +:octicons-tag-24: Unreleased + +Default: Enabled + +Cabal defines a test suite interface +['exitcode-stdio-1.0'](https://hackage.haskell.org/package/Cabal-syntax-3.8.1.0/docs/Distribution-Types-TestSuiteInterface.html#v:TestSuiteExeV1.0) +where the test suite takes the form of an executable and the executable takes +nothing on the standard input channel (`stdin`). Pass this flag to override that +specification and allow the executable to receive input on that channel. If you +pass `--no-tests-allow-stdin` and the executable seeks input on the standard +input channel, an exception will be thown. + ## Composition To come back to the composable approach described above, consider this example diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index caf7947309..9a2ed7a312 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -2024,16 +2024,22 @@ singleTest topts testsToRun ac ee task installedMap = do mec <- withWorkingDir (toFilePath pkgDir) $ optionalTimeout $ proc (toFilePath exePath) args $ \pc0 -> do - stdinBS <- + changeStdin <- if isTestTypeLib then do logPath <- buildLogPath package (Just stestName) ensureDir (parent logPath) - pure $ BL.fromStrict + pure $ setStdin + $ byteStringInput + $ BL.fromStrict $ encodeUtf8 $ fromString $ show (logPath, mkUnqualComponentName (T.unpack testName)) - else pure mempty - let pc = setStdin (byteStringInput stdinBS) + else do + isTerminal <- view $ globalOptsL.to globalTerminal + if toAllowStdin topts && isTerminal + then pure id + else pure $ setStdin $ byteStringInput mempty + let pc = changeStdin $ setStdout output $ setStderr output pc0 diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs index c3b17e8322..e83f72d243 100644 --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -81,6 +81,7 @@ testOptsFromMonoid TestOptsMonoid{..} madditional = , toCoverage = fromFirstFalse toMonoidCoverage , toDisableRun = fromFirstFalse toMonoidDisableRun , toMaximumTimeSeconds = fromFirst (toMaximumTimeSeconds defaultTestOpts) toMonoidMaximumTimeSeconds + , toAllowStdin = fromFirstTrue toMonoidAllowStdin } benchmarkOptsFromMonoid :: BenchmarkOptsMonoid -> Maybe [String] -> BenchmarkOpts diff --git a/src/Stack/Options/TestParser.hs b/src/Stack/Options/TestParser.hs index 2e0fcf2068..cd4990a53f 100644 --- a/src/Stack/Options/TestParser.hs +++ b/src/Stack/Options/TestParser.hs @@ -42,4 +42,8 @@ testOptsParser hide0 = (long "test-suite-timeout" <> help "Maximum test suite run time in seconds." <> hide)) + <*> firstBoolFlagsTrue + "tests-allow-stdin" + "allow standard input in test executables" + hide where hide = hideMods hide0 diff --git a/src/Stack/Types/Config/Build.hs b/src/Stack/Types/Config/Build.hs index 398a583fb6..000d428215 100644 --- a/src/Stack/Types/Config/Build.hs +++ b/src/Stack/Types/Config/Build.hs @@ -363,6 +363,7 @@ data TestOpts = ,toCoverage :: !Bool -- ^ Generate a code coverage report ,toDisableRun :: !Bool -- ^ Disable running of tests ,toMaximumTimeSeconds :: !(Maybe Int) -- ^ test suite timeout in seconds + ,toAllowStdin :: !Bool -- ^ Whether to allow standard input } deriving (Eq,Show) defaultTestOpts :: TestOpts @@ -372,6 +373,7 @@ defaultTestOpts = TestOpts , toCoverage = defaultFirstFalse toMonoidCoverage , toDisableRun = defaultFirstFalse toMonoidDisableRun , toMaximumTimeSeconds = Nothing + , toAllowStdin = defaultFirstTrue toMonoidAllowStdin } data TestOptsMonoid = @@ -381,6 +383,7 @@ data TestOptsMonoid = , toMonoidCoverage :: !FirstFalse , toMonoidDisableRun :: !FirstFalse , toMonoidMaximumTimeSeconds :: !(First (Maybe Int)) + , toMonoidAllowStdin :: !FirstTrue } deriving (Show, Generic) instance FromJSON (WithJSONWarnings TestOptsMonoid) where @@ -390,6 +393,7 @@ instance FromJSON (WithJSONWarnings TestOptsMonoid) where toMonoidCoverage <- FirstFalse <$> o ..:? toMonoidCoverageArgName toMonoidDisableRun <- FirstFalse <$> o ..:? toMonoidDisableRunArgName toMonoidMaximumTimeSeconds <- First <$> o ..:? toMonoidMaximumTimeSecondsArgName + toMonoidAllowStdin <- FirstTrue <$> o ..:? toMonoidTestsAllowStdinName pure TestOptsMonoid{..}) toMonoidRerunTestsArgName :: Text @@ -407,6 +411,9 @@ toMonoidDisableRunArgName = "no-run-tests" toMonoidMaximumTimeSecondsArgName :: Text toMonoidMaximumTimeSecondsArgName = "test-suite-timeout" +toMonoidTestsAllowStdinName :: Text +toMonoidTestsAllowStdinName = "tests-allow-stdin" + instance Semigroup TestOptsMonoid where (<>) = mappenddefault diff --git a/src/test/Stack/ConfigSpec.hs b/src/test/Stack/ConfigSpec.hs index 88bbc5bdcf..db93c1983f 100644 --- a/src/test/Stack/ConfigSpec.hs +++ b/src/test/Stack/ConfigSpec.hs @@ -174,14 +174,17 @@ spec = beforeAll setup $ do boptsKeepTmpFiles `shouldBe` True boptsForceDirty `shouldBe` True boptsTests `shouldBe` True - boptsTestOpts `shouldBe` TestOpts {toRerunTests = True - ,toAdditionalArgs = ["-fprof"] - ,toCoverage = True - ,toDisableRun = True - ,toMaximumTimeSeconds = Nothing} + boptsTestOpts `shouldBe` TestOpts { toRerunTests = True + , toAdditionalArgs = ["-fprof"] + , toCoverage = True + , toDisableRun = True + , toMaximumTimeSeconds = Nothing + , toAllowStdin = False + } boptsBenchmarks `shouldBe` True - boptsBenchmarkOpts `shouldBe` BenchmarkOpts {beoAdditionalArgs = Just "-O2" - ,beoDisableRun = True} + boptsBenchmarkOpts `shouldBe` BenchmarkOpts { beoAdditionalArgs = Just "-O2" + , beoDisableRun = True + } boptsReconfigure `shouldBe` True boptsCabalVerbose `shouldBe` CabalVerbosity verbose