damlc: add option to filter which scenarios to run (#13600)

This adds an option to specify a pattern such that only tests containing
the given pattern in their name will be executed.

Fixes #13534.

CHANGELOG_BEGIN
CHANGELOG_END

compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs

@@ -823,8 +823,9 @@ runScenariosRule =
     define $ \RunScenarios file -> do
       m <- moduleForScenario file
       world <- worldForFile file
-      let scenarios = map fst $ scenariosInModule m
       Just scenarioService <- envScenarioService <$> getDamlServiceEnv
+      testFilter <- envTestFilter <$> getDamlServiceEnv
+      let scenarios =  [sc | (sc, _scLoc) <- scenariosInModule m, testFilter $ LF.unExprValName $ LF.qualObject sc]
       ctxRoot <- use_ GetScenarioRoot file
       ctxId <- use_ CreateScenarioContext ctxRoot
       scenarioResults <-
@@ -842,8 +843,9 @@ runScriptsRule =
     define $ \RunScripts file -> do
       m <- moduleForScenario file
       world <- worldForFile file
-      let scenarios = map fst $ scriptsInModule m
       Just scenarioService <- envScenarioService <$> getDamlServiceEnv
+      testFilter <- envTestFilter <$> getDamlServiceEnv
+      let scenarios =  [sc | (sc, _scLoc) <- scriptsInModule m, testFilter $ LF.unExprValName $ LF.qualObject sc]
       ctxRoot <- use_ GetScenarioRoot file
       ctxId <- use_ CreateScenarioContext ctxRoot
       scenarioResults <-

compiler/damlc/daml-ide-core/src/Development/IDE/Core/Service/Daml.hs

@@ -56,6 +56,7 @@ data DamlEnv = DamlEnv
   , envSkipScenarioValidation :: SkipScenarioValidation
   , envIsGenerated :: Bool
   , envEnableScenarios :: EnableScenarios
+  , envTestFilter :: T.Text -> Bool
   }
 
 instance IsIdeGlobal DamlEnv
@@ -74,6 +75,7 @@ mkDamlEnv opts scenarioService = do
         , envSkipScenarioValidation = optSkipScenarioValidation opts
         , envIsGenerated = optIsGenerated opts
         , envEnableScenarios = optEnableScenarios opts
+        , envTestFilter = optTestFilter opts
         }
 
 getDamlServiceEnv :: Action DamlEnv

compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs

@@ -83,6 +83,8 @@ data Options = Options
   , optEnableScenarios :: EnableScenarios
     -- ^ Whether old-style scenarios should be run by the scenario service.
     -- This will be switched to False by default once scenarios are no longer supported in 2.0.
+  , optTestFilter :: T.Text -> Bool
+    -- ^ Only execute tests with a name for which the given predicate holds.
   , optSkipScenarioValidation :: SkipScenarioValidation
     -- ^ Controls whether the scenario service server run package validations.
     -- This is mostly used to run additional checks on CI while keeping the IDE fast.
@@ -113,7 +115,7 @@ data Options = Options
   , optAccessTokenPath :: Maybe FilePath
   -- ^ Path to a file containing an access JWT token. This is used for building to query/fetch
   -- packages from remote ledgers.
-  } deriving Show
+  }
 
 newtype IncrementalBuild = IncrementalBuild { getIncrementalBuild :: Bool }
   deriving Show
@@ -193,6 +195,7 @@ defaultOptions mbVersion =
         , optGhcCustomOpts = []
         , optScenarioService = EnableScenarioService True
         , optEnableScenarios = EnableScenarios False
+        , optTestFilter = const True
         , optSkipScenarioValidation = SkipScenarioValidation False
         , optDlintUsage = DlintDisabled
         , optIsGenerated = False

compiler/damlc/lib/DA/Cli/Damlc/Command/Damldoc.hs

@@ -253,7 +253,7 @@ data CmdArgs = Damldoc
     , cAnchorPath :: Maybe FilePath
     , cExternalAnchorPath :: Maybe FilePath
     , cMainFiles :: [FilePath]
-    } deriving (Show)
+    }
 
 exec :: CmdArgs -> IO ()
 exec Damldoc{..} = do

compiler/damlc/lib/DA/Cli/Options.hs

@@ -19,6 +19,7 @@ import DA.Daml.Project.Types
 import qualified DA.Service.Logger as Logger
 import qualified Module as GHC
 import qualified Text.ParserCombinators.ReadP as R
+import qualified Data.Text as T
 
 
 -- | Pretty-printing documents with syntax-highlighting annotations.
@@ -302,6 +303,7 @@ optionsParser numProcessors enableScenarioService parsePkgName = do
     let optEnableOfInterestRule = False
     optCppPath <- optCppPath
     optEnableScenarios <- enableScenariosOpt
+    optTestFilter <- compilePatternExpr <$> optTestPattern
 
     return Options{..}
   where
@@ -379,6 +381,18 @@ optionsParser numProcessors enableScenarioService parsePkgName = do
         long "generated-src" <>
         internal
 
+    optTestPattern :: Parser (Maybe String)
+    optTestPattern = optional . option str
+        $ metavar "PATTERN"
+        <> long "test-pattern"
+        <> short 'p'
+        <> help "Only scripts with names containing the given pattern will be executed."
+
+    compilePatternExpr :: Maybe String -> (T.Text -> Bool)
+    compilePatternExpr = \case
+      Nothing -> const True
+      Just needle ->  T.isInfixOf (T.pack needle)
+
     -- optparse-applicative does not provide a nice way
     -- to make the argument for -j optional, see
     -- https://github.com/pcapriotti/optparse-applicative/issues/243

compiler/damlc/tests/src/DamlcTest.hs

@@ -408,6 +408,63 @@ testsForDamlcTest damlc scriptDar script1DevDar = testGroup "damlc test" $
                  ] `isSuffixOf`
              stdout)
           exitCode @?= ExitSuccess
+    , testCase "Filter tests with --test-pattern" $ withTempDir $ \projDir -> do
+          createDirectoryIfMissing True (projDir </> "a")
+          writeFileUTF8 (projDir </> "a" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: a"
+            , "version: 0.0.1"
+            , "source: ."
+            , "dependencies: [daml-prim, daml-stdlib, " <> show scriptDar <> "]"
+            ]
+          writeFileUTF8 (projDir </> "a" </> "A.daml") $ unlines
+            [ "module A where"
+            , "import Daml.Script"
+            , "test_needleHaystack = script $ pure ()"
+            ]
+          callProcessSilent
+            damlc
+            [ "build"
+            , "--project-root"
+            , projDir </> "a"
+            ]
+          createDirectoryIfMissing True (projDir </> "b")
+          writeFileUTF8 (projDir </> "b" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: b"
+            , "version: 0.0.1"
+            , "source: ."
+            , "dependencies: [daml-prim, daml-stdlib, " <> show (projDir </> "a/.daml/dist/a-0.0.1.dar") <> ", " <> show scriptDar <> "]"
+            ]
+          let bFilePath = projDir </> "b" </> "B.daml"
+          writeFileUTF8 bFilePath $ unlines
+            [ "module B where"
+            , "import Daml.Script"
+            , "import qualified A"
+            , "test = script $ pure ()"
+            , "needleHaystack = script $ pure ()"
+            , "test1 = A.test_needleHaystack"
+            ]
+          (exitCode, stdout, stderr) <-
+            readProcessWithExitCode
+              damlc
+                [ "test"
+                , "--test-pattern"
+                , "needle"
+                , "--all"
+                , "--project-root"
+                , projDir </> "b"
+                , "--files"
+                , bFilePath ]
+                ""
+          stderr @?= ""
+          assertBool ("Test coverage is reported correctly: " <> stdout)
+            (unlines
+              ["B.daml:needleHaystack: ok, 0 active contracts, 0 transactions."
+              , "a:test_needleHaystack: ok, 0 active contracts, 0 transactions."
+              , "test coverage: templates 100%, choices 100%"
+              ] `isSuffixOf` stdout)
+          exitCode @?= ExitSuccess
     , testCase "Full test coverage report without --all set (but imports)" $ withTempDir $ \projDir -> do
           createDirectoryIfMissing True (projDir </> "a")
           writeFileUTF8 (projDir </> "a" </> "daml.yaml") $ unlines