Make "damlc test" exit with non-zero exit code on failed scenarios (#394)

fixes #291

daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Options.hs

@@ -4,6 +4,7 @@
 module DA.Daml.GHC.Compiler.Options
     ( Options(..)
     , defaultOptionsIO
+    , defaultOptions
     , mkOptions
     , getBaseDir
     , toCompileOpts
@@ -115,8 +116,11 @@ mkOptions opts@Options {..} = do
 -- and located runfiles. If the version argument is Nothing it is set to the default daml-lf
 -- version.
 defaultOptionsIO :: Maybe LF.Version -> IO Options
-defaultOptionsIO mbVersion = do
+defaultOptionsIO mbVersion = mkOptions $ defaultOptions mbVersion
-    mkOptions Options
+
+defaultOptions :: Maybe LF.Version -> Options
+defaultOptions mbVersion =
+    Options
         { optImportPath = []
         , optPackageDbs = []
         , optMbPackageName = Nothing

daml-foundations/daml-tools/da-hs-daml-cli/DA/Cli/Damlc.hs

@@ -36,6 +36,7 @@ import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty
 import Data.ByteArray.Encoding (Base (Base16), convertToBase)
 import qualified Data.ByteString                   as B
 import qualified Data.ByteString.Lazy as BSL
+import Data.Either
 import Data.FileEmbed (embedFile)
 import Data.Functor
 import qualified Data.Set as Set
@@ -335,19 +336,21 @@ prettyResult lfVersion errOrResult = case errOrResult of
     <> DA.Pretty.int nTx <> " transactions."
 
 testStdio :: LF.Version -> IdeState -> [FilePath] -> IO ()
-testStdio lfVersion hDamlGhc files =
+testStdio lfVersion hDamlGhc files = do
-    CompilerService.runAction hDamlGhc $
+    failed <- fmap or $ CompilerService.runAction hDamlGhc $
-        void $ Shake.forP files $ \file -> do
+        Shake.forP files $ \file -> do
             mbScenarioResults <- CompilerService.runScenarios file
             scenarioResults <- liftIO $ maybe (reportDiagnostics hDamlGhc "Failed to run scenarios") pure mbScenarioResults
             liftIO $ forM_ scenarioResults $ \(VRScenario vrFile vrName, result) -> do
                 let doc = prettyResult lfVersion result
                 let name = DA.Pretty.string vrFile <> ":" <> DA.Pretty.pretty vrName
                 putStrLn $ DA.Pretty.renderPlain (name <> ": " <> doc)
+            pure $ any (isLeft . snd) scenarioResults
+    when failed exitFailure
 
 testJUnit :: LF.Version -> IdeState -> [FilePath] -> FilePath -> IO ()
-testJUnit lfVersion hDamlGhc files junitOutput =
+testJUnit lfVersion hDamlGhc files junitOutput = do
-    CompilerService.runAction hDamlGhc $ do
+    failed <- CompilerService.runAction hDamlGhc $ do
         results <- Shake.forP files $ \file -> do
             scenarios <- CompilerService.getScenarios file
             mbScenarioResults <- CompilerService.runScenarios file
@@ -365,6 +368,8 @@ testJUnit lfVersion hDamlGhc files junitOutput =
         liftIO $ do
             createDirectoryIfMissing True $ takeDirectory junitOutput
             writeFile junitOutput $ XML.showTopElement $ toJUnit results
+        pure (any (any (isJust . snd) . snd) results)
+    when failed exitFailure
 
 
 toJUnit :: [(FilePath, [(VirtualResource, Maybe T.Text)])] -> XML.Element

daml-foundations/daml-tools/da-hs-daml-cli/tests/DamlcTest.hs

@@ -8,6 +8,7 @@ module DamlcTest
 import Control.Exception
 import qualified Data.Text.Extended as T
 import System.Environment
+import System.Exit
 import System.IO.Extra
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -20,14 +21,19 @@ main = do
     setEnv "TASTY_NUM_THREADS" "1"
     defaultMain tests
 
+-- execTest will call mkOptions internally. Since each call to mkOptions
+-- appends the LF version to the package db paths, it is important that we use
+-- defaultOptions instead of defaultOptionsIO since the version suffix is otherwise
+-- appended twice.
+opts :: Options
+opts = defaultOptions Nothing
+
 tests :: TestTree
 tests = testGroup
     "damlc test"
     [ testCase "Non-existent file" $ do
-        opts <- defaultOptionsIO Nothing
         shouldThrow (Damlc.execTest "foobar" Nothing opts)
     , testCase "File with compile error" $ do
-        opts <- defaultOptionsIO Nothing
         withTempFile $ \path -> do
             T.writeFileUtf8 path $ T.unlines
               [ "daml 1.2"
@@ -35,8 +41,23 @@ tests = testGroup
               , "abc"
               ]
             shouldThrow (Damlc.execTest path Nothing opts)
+    , testCase "File with failing scenario" $ do
+        withTempFile $ \path -> do
+            T.writeFileUtf8 path $ T.unlines
+              [ "daml 1.2"
+              , "module Foo where"
+              , "x = scenario $ assert False"
+              ]
+            shouldThrowExitFailure (Damlc.execTest path Nothing opts)
     ]
 
+shouldThrowExitFailure :: IO () -> IO ()
+shouldThrowExitFailure a = do
+    r <- try a
+    case r of
+        Left (ExitFailure _) -> pure ()
+        _ -> assertFailure "Expected program to fail with non-zero exit code."
+
 shouldThrow :: IO () -> IO ()
 shouldThrow a = do
     r <- try a

docs/source/daml/daml-studio/daml/Abort.daml

@@ -4,8 +4,8 @@
 daml 1.2
 module Abort where
 
--- {-
+{-
 abortTest = scenario do
   debug "hello, world!"
   abort "stop"
--- -}
+-}