Add interfaces & interface choices to coverage report (#15563)

* extract interface info for coverage

* Remove commented out Summary monoid code

* DRY up identifier creator

* remove unused summarize usage

* Disambiguate template/interface identifiers & choices via Variety

* Redesign extractors & start printing reports

* Reformat, begin proper counting of implementation choices

* Fix filter for interface archives choices to exclude, not include

* Remove commented code in printTestCoverage

* Fix lint

* Add external report

* Add percentages to coverage report

* Complete `External interface choices` report section

* Forgot to extract sizes from implementationChoices

* Remove unused allExercisedImplementationChoices

* Improve pctage reporter

* Report uncovered templates/choices when getShowCoverage is True

* Flip getShowCoverage check

* Fix width of percentages in coverage report

* Update damlc tests for coverage report

* Fix filter & text for external interface implementations

* Remove unused / misused Variant, Report, and interfaceChoices extractor

* add section header to never created/exercised summaries

compiler/damlc/lib/DA/Cli/Damlc/Test.hs

@@ -1,6 +1,7 @@
 -- Copyright (c) 2022 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
+{-# LANGUAGE DuplicateRecordFields #-}
 
 -- | Main entry-point of the Daml compiler
 module DA.Cli.Damlc.Test (
@@ -8,6 +9,7 @@ module DA.Cli.Damlc.Test (
     , UseColor(..)
     , ShowCoverage(..)
     , RunAllTests(..)
+    -- , Summarize(..)
     ) where
 
 import Control.Monad.Except
@@ -25,7 +27,6 @@ import Data.List.Extra
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.NameMap as NM
-import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Data.Tuple.Extra
@@ -44,6 +45,7 @@ import System.Directory (createDirectoryIfMissing)
 import System.Exit (exitFailure)
 import System.FilePath
 import qualified Text.XML.Light as XML
+import Text.Printf
 
 
 newtype UseColor = UseColor {getUseColor :: Bool}
@@ -169,127 +171,205 @@ printSummary color res =
         ]
     printScenarioResults color res
 
-data TemplateIdentifier = TemplateIdentifier
+data ContractIdentifier = ContractIdentifier
     { package :: Maybe T.Text -- `package == Nothing` means local package
-    , qualifiedTemplate :: T.Text
+    , qualifiedName :: T.Text
     }
     deriving (Eq, Ord, Show)
 
 data ChoiceIdentifier = ChoiceIdentifier
-    { packageTemplate :: TemplateIdentifier
+    { packageContract :: ContractIdentifier
     , choice :: T.Text
     }
     deriving (Eq, Ord, Show)
 
-data Report = Report
-    { groupName :: String
-    , definedChoicesInside :: S.Set ChoiceIdentifier
-    , internalExercisedAnywhere :: S.Set ChoiceIdentifier
-    , internalExercisedInternal :: S.Set ChoiceIdentifier
-    , externalExercisedInternal :: S.Set ChoiceIdentifier
-    , definedTemplatesInside :: S.Set TemplateIdentifier
-    , internalCreatedAnywhere :: S.Set TemplateIdentifier
-    , internalCreatedInternal :: S.Set TemplateIdentifier
-    , externalCreatedInternal :: S.Set TemplateIdentifier
-    }
-    deriving (Show, Eq, Ord)
+lfTemplateIdentifier :: LF.Qualified LF.Template -> ContractIdentifier
+lfTemplateIdentifier = lfMkNameIdentifier . fmap LF.tplTypeCon
+
+lfInterfaceIdentifier :: LF.Qualified LF.DefInterface -> ContractIdentifier
+lfInterfaceIdentifier = lfMkNameIdentifier . fmap LF.intName
+
+lfMkNameIdentifier :: LF.Qualified LF.TypeConName -> ContractIdentifier
+lfMkNameIdentifier LF.Qualified { qualPackage, qualModule, qualObject } =
+    let package =
+            case qualPackage of
+              LF.PRSelf -> Nothing
+              LF.PRImport (LF.PackageId pid) -> Just pid
+        qualifiedName =
+            LF.moduleNameString qualModule
+                <> ":"
+                <> T.concat (LF.unTypeConName qualObject)
+    in
+    ContractIdentifier { package, qualifiedName }
+
+ssIdentifierToIdentifier :: SS.Identifier -> ContractIdentifier
+ssIdentifierToIdentifier SS.Identifier {SS.identifierPackage, SS.identifierName} =
+    let package = do
+            pIdSumM <- identifierPackage
+            pIdSum <- SS.packageIdentifierSum pIdSumM
+            case pIdSum of
+                SS.PackageIdentifierSumSelf _ -> Nothing
+                SS.PackageIdentifierSumPackageId pId -> Just $ TL.toStrict pId
+        qualifiedName = TL.toStrict identifierName
+    in
+    ContractIdentifier { package, qualifiedName }
 
 printTestCoverage ::
     ShowCoverage
     -> [LocalOrExternal]
     -> [(LocalOrExternal, [(VirtualResource, Either SSC.Error SS.ScenarioResult)])]
     -> IO ()
-printTestCoverage ShowCoverage {getShowCoverage} allPackages results
+printTestCoverage ShowCoverage{getShowCoverage} allPackages results
   | any (isLeft . snd) $ concatMap snd results = pure ()
-  | otherwise = do
-      printReport $ report "defined in local modules" isLocal
-      printReport $ report "defined in external modules" (not . isLocal)
-      printReport $ report "defined anywhere" (const True)
+  | otherwise = printReport
   where
-    report :: String -> (LocalOrExternal -> Bool) -> Report
-    report groupName pred =
-        let allMatchingPackages = filter pred allPackages
-            allMatchingResults = map snd $ filter (pred . fst) results
-            definedTemplatesInside = M.keysSet $ templatesDefinedIn allMatchingPackages
-            definedChoicesInside = M.keysSet $ choicesDefinedIn allMatchingPackages
-            exercisedInside = foldMap exercisedChoices allMatchingResults
-            createdInside = foldMap createdTemplates allMatchingResults
-            internalExercisedAnywhere = allExercisedChoices `S.intersection` definedChoicesInside
-            internalExercisedInternal = exercisedInside `S.intersection` definedChoicesInside
-            externalExercisedInternal = exercisedInside `S.difference` definedChoicesInside
-            internalCreatedAnywhere = allCreatedTemplates `S.intersection` definedTemplatesInside
-            internalCreatedInternal = createdInside `S.intersection` definedTemplatesInside
-            externalCreatedInternal = createdInside `S.difference` definedTemplatesInside
-        in
-        Report
-            { groupName
-            , definedChoicesInside
-            , internalExercisedAnywhere
-            , internalExercisedInternal
-            , externalExercisedInternal
-            , definedTemplatesInside
-            , internalCreatedAnywhere
-            , internalCreatedInternal
-            , externalCreatedInternal
-            }
+    printReport :: IO ()
+    printReport =
+        let countWhere pred = M.size . M.filter pred
+            pctage :: Int -> Int -> Double
+            pctage _ 0 = 100
+            pctage n d = max 0 $ min 100 $ 100 * fromIntegral n / fromIntegral d
 
-    printReport :: Report -> IO ()
-    printReport
-        Report
-            { groupName
-            , definedChoicesInside
-            , internalExercisedAnywhere
-            , definedTemplatesInside
-            , internalCreatedAnywhere
-            } =
-        let percentage i j
-              | j > 0 = show (round @Double $ 100.0 * (fromIntegral i / fromIntegral j) :: Int) <> "%"
-              | otherwise = "100%"
-            frac msg a b = msg ++ ": " ++ show a ++ " / " ++ show b
-            pct msg a b = frac msg a b ++ " (" ++ percentage a b ++ ")"
-            indent = ("  " ++)
-            header = groupName ++ ":"
-            body1 =
-                [ pct "choices" (S.size internalExercisedAnywhere) (S.size definedChoicesInside)
-                , pct "templates" (S.size internalCreatedAnywhere) (S.size definedTemplatesInside)
-                ]
-            body2
+            allTemplates = templatesDefinedIn allPackages
+            localTemplates = M.filterWithKey pred allTemplates
+              where
+                pred (ContractIdentifier Nothing _) _ = True
+                pred _ _ = False
+            localTemplatesCreated = M.intersection allCreatedContracts localTemplates
+
+            allTemplateChoices = templateChoicesDefinedIn allPackages
+            localTemplateChoices = M.filterWithKey pred allTemplateChoices
+              where
+                pred (ChoiceIdentifier (ContractIdentifier Nothing _) _) _ = True
+                pred _ _ = False
+            localTemplateChoicesExercised = M.intersection allExercisedChoices localTemplateChoices
+
+            allInterfaces = interfacesDefinedIn allPackages
+            allImplementations = interfaceImplementationsDefinedIn allPackages
+            fillInImplementation (ifaceId, _) (loe, instanceBody) = (loe, instanceBody, M.lookup ifaceId allInterfaces)
+
+            allImplementationChoices = M.fromList $ do
+                (k@(_, contractId), (loe, body, mdef)) <- M.toList $ M.mapWithKey fillInImplementation allImplementations
+                def <- maybeToList mdef
+                choice <- NM.toList $ LF.intChoices $ LF.qualObject def
+                let name = LF.unChoiceName $ LF.chcName choice
+                guard (name /= "Archive")
+                pure (ChoiceIdentifier contractId name, (k, loe, body, def, choice))
+
+            localImplementationChoices = M.filter pred allImplementationChoices
+              where
+                pred (_, loe, _, _, _) = isLocal loe
+            localImplementationChoicesExercised = M.intersection allExercisedChoices localImplementationChoices
+            externalImplementationChoices = M.filter pred allImplementationChoices
+              where
+                pred (_, loe, _, _, _) = not (isLocal loe)
+            externalImplementationChoicesExercised = M.intersection allExercisedChoices externalImplementationChoices
+
+            externalTemplates = M.filterWithKey pred allTemplates
+              where
+                pred (ContractIdentifier (Just _) _) _ = True
+                pred _ _ = False
+            externalTemplatesCreated = M.intersection allCreatedContracts externalTemplates
+
+            externalTemplateChoices = M.filterWithKey pred allTemplateChoices
+              where
+                pred (ChoiceIdentifier (ContractIdentifier (Just _) _) _) _ = True
+                pred _ _ = False
+            externalTemplateChoicesExercised = M.intersection allExercisedChoices externalTemplateChoices
+
+            showCoverageReport :: (k -> String) -> String -> M.Map k a -> [String]
+            showCoverageReport printer variety names
               | not getShowCoverage = []
               | otherwise =
-                [ "templates never created:" ] <>
-                map (indent . printTemplateIdentifier) (S.toList $ definedTemplatesInside `S.difference` internalCreatedAnywhere) <>
-                ["choices never executed:"] <>
-                map (indent . printChoiceIdentifier) (S.toList $ definedChoicesInside `S.difference` internalExercisedAnywhere)
-            msg = unlines $ header : map indent (body1 ++ body2)
+                [ printf "  %s: %d" variety (M.size names)
+                ] ++ [ "    " ++ printer id | id <- M.keys names ]
         in
-        putStrLn msg
+        putStrLn $
+        unlines $
+        concat
+        [ [ printf "Modules internal to this package:" ]
+        -- Can't have any external tests that exercise internals, as that would
+        -- require a circular dependency, so we only report local test results
+        , let defined = M.size localTemplates
+              created = M.size localTemplatesCreated
+              neverCreated = M.difference localTemplates localTemplatesCreated
+          in
+          [ printf "- Internal templates"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) created" created (pctage created defined)
+          ] ++ showCoverageReport printContractIdentifier "internal templates never created" neverCreated
+        , let defined = M.size localTemplateChoices
+              exercised = M.size localTemplateChoicesExercised
+              neverExercised = M.difference localTemplateChoices localTemplateChoicesExercised
+          in
+          [ printf "- Internal template choices"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) exercised" exercised (pctage exercised defined)
+          ] ++ showCoverageReport printChoiceIdentifier "internal template choices never exercised" neverExercised
+        , let defined = countWhere (isLocal . fst) allImplementations
+              internal = countWhere (isLocal . fst) allImplementations
+              external = countWhere (not . isLocal . fst) allImplementations
+          in
+          [ printf "- Internal interface implementations"
+          , printf "  %d defined" defined
+          , printf "    %d internal interfaces" internal
+          , printf "    %d external interfaces" external
+          ]
+        , let defined = M.size localImplementationChoices
+              exercised = M.size localImplementationChoicesExercised
+              neverExercised = M.difference localImplementationChoices localImplementationChoicesExercised
+          in
+          [ printf "- Internal interface choices"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) exercised" exercised (pctage exercised defined)
+          ] ++ showCoverageReport printChoiceIdentifier "internal interface choices never exercised" neverExercised
+        , [ printf "Modules external to this package:" ]
+        -- Here, interface instances can only refer to external templates and
+        -- interfaces, so we only report external interface instances
+        , let defined = M.size externalTemplates
+              createdAny = M.size externalTemplatesCreated
+              createdInternal = countWhere (any isLocal) externalTemplatesCreated
+              createdExternal = countWhere (not . all isLocal) externalTemplatesCreated
+              neverCreated = M.difference externalTemplates externalTemplatesCreated
+          in
+          [ printf "- External templates"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) created in any tests" createdAny (pctage createdAny defined)
+          , printf "  %d (%5.1f%%) created in internal tests" createdInternal (pctage createdInternal defined)
+          , printf "  %d (%5.1f%%) created in external tests" createdExternal (pctage createdExternal defined)
+          ] ++ showCoverageReport printContractIdentifier "external templates never created" neverCreated
+        , let defined = M.size externalTemplateChoices
+              exercisedAny = M.size externalTemplateChoicesExercised
+              exercisedInternal = countWhere (any isLocal) externalTemplateChoicesExercised
+              exercisedExternal = countWhere (not . all isLocal) externalTemplateChoicesExercised
+              neverExercised = M.difference externalTemplateChoices externalTemplateChoicesExercised
+          in
+          [ printf "- External template choices"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) exercised in any tests" exercisedAny (pctage exercisedAny defined)
+          , printf "  %d (%5.1f%%) exercised in internal tests" exercisedInternal (pctage exercisedInternal defined)
+          , printf "  %d (%5.1f%%) exercised in external tests" exercisedExternal (pctage exercisedExternal defined)
+          ] ++ showCoverageReport printChoiceIdentifier "external template choices never exercised" neverExercised
+        , let defined = countWhere (not . isLocal . fst) allImplementations
+          in
+          [ printf "- External interface implementations"
+          , printf "  %d defined" defined
+          ]
+        , let defined = M.size externalImplementationChoices
+              exercisedAny = M.size externalImplementationChoicesExercised
+              exercisedInternal = countWhere (any isLocal) externalImplementationChoicesExercised
+              exercisedExternal = countWhere (not . all isLocal) externalImplementationChoicesExercised
+              neverExercised = M.difference externalImplementationChoices externalImplementationChoicesExercised
+          in
+          [ printf "- External interface choices"
+          , printf "  %d defined" defined
+          , printf "  %d (%5.1f%%) exercised in any tests" exercisedAny (pctage exercisedAny defined)
+          , printf "  %d (%5.1f%%) exercised in internal tests" exercisedInternal (pctage exercisedInternal defined)
+          , printf "  %d (%5.1f%%) exercised in external tests" exercisedExternal (pctage exercisedExternal defined)
+          ] ++ showCoverageReport printChoiceIdentifier "external interface choices never exercised" neverExercised
+        ]
 
-    lfTemplateIdentifier :: LF.Qualified LF.Template -> TemplateIdentifier
-    lfTemplateIdentifier LF.Qualified { qualPackage, qualModule, qualObject } =
-        let package =
-                case qualPackage of
-                  LF.PRSelf -> Nothing
-                  LF.PRImport (LF.PackageId pid) -> Just pid
-            qualifiedTemplate =
-                LF.moduleNameString qualModule
-                    <> ":"
-                    <> T.concat (LF.unTypeConName (LF.tplTypeCon qualObject))
-        in
-        TemplateIdentifier { package, qualifiedTemplate }
-
-    ssIdentifierToIdentifier :: SS.Identifier -> TemplateIdentifier
-    ssIdentifierToIdentifier SS.Identifier {SS.identifierPackage, SS.identifierName} =
-        let package = do
-                pIdSumM <- identifierPackage
-                pIdSum <- SS.packageIdentifierSum pIdSumM
-                case pIdSum of
-                    SS.PackageIdentifierSumSelf _ -> Nothing
-                    SS.PackageIdentifierSumPackageId pId -> Just $ TL.toStrict pId
-            qualifiedTemplate = TL.toStrict identifierName
-        in
-        TemplateIdentifier { package, qualifiedTemplate }
-
-    templatesDefinedIn :: [LocalOrExternal] -> M.Map TemplateIdentifier (LF.Qualified LF.Template)
+    templatesDefinedIn :: [LocalOrExternal] -> M.Map ContractIdentifier (LF.Qualified LF.Template)
     templatesDefinedIn localOrExternals = M.fromList
         [ (lfTemplateIdentifier templateInfo, templateInfo)
         | localOrExternal <- localOrExternals
@@ -298,24 +378,48 @@ printTestCoverage ShowCoverage {getShowCoverage} allPackages results
         , let templateInfo = qualifier template
         ]
 
-    choicesDefinedIn :: [LocalOrExternal] -> M.Map ChoiceIdentifier (LF.Qualified LF.Template, LF.TemplateChoice)
-    choicesDefinedIn localOrExternals = M.fromList
+    interfacesDefinedIn :: [LocalOrExternal] -> M.Map ContractIdentifier (LF.Qualified LF.DefInterface)
+    interfacesDefinedIn localOrExternals = M.fromList
+        [ (lfInterfaceIdentifier interfaceInfo, interfaceInfo)
+        | localOrExternal <- localOrExternals
+        , (module_, qualifier) <- loeGetModules localOrExternal
+        , interface <- NM.toList $ LF.moduleInterfaces module_
+        , let interfaceInfo = qualifier interface
+        ]
+
+    templateChoicesDefinedIn :: [LocalOrExternal] -> M.Map ChoiceIdentifier (LF.Qualified LF.Template, LF.TemplateChoice)
+    templateChoicesDefinedIn localOrExternals = M.fromList
         [ (ChoiceIdentifier templateIdentifier name, (templateInfo, choice))
         | (templateIdentifier, templateInfo) <- M.toList $ templatesDefinedIn localOrExternals
         , choice <- NM.toList $ LF.tplChoices $ LF.qualObject templateInfo
         , let name = LF.unChoiceName $ LF.chcName choice
         ]
 
-    allCreatedTemplates :: S.Set TemplateIdentifier
-    allCreatedTemplates = foldMap (createdTemplates . snd) results
+    interfaceImplementationsDefinedIn :: [LocalOrExternal] -> M.Map (ContractIdentifier, ContractIdentifier) (LocalOrExternal, LF.InterfaceInstanceBody)
+    interfaceImplementationsDefinedIn localOrExternals = M.fromList $
+        [ ((lfMkNameIdentifier tpiInterface, templateIdentifier), (loe, tpiBody))
+        | loe <- localOrExternals
+        , (templateIdentifier, templateInfo) <- M.toList $ templatesDefinedIn [loe]
+        , LF.TemplateImplements { tpiInterface, tpiBody }
+            <- NM.toList $ LF.tplImplements $ LF.qualObject templateInfo
+        ] ++
+        [ ((interfaceIdentifier, lfMkNameIdentifier iciTemplate), (loe, iciBody))
+        | loe <- localOrExternals
+        , (interfaceIdentifier, interfaceInfo) <- M.toList $ interfacesDefinedIn [loe]
+        , LF.InterfaceCoImplements { iciTemplate, iciBody }
+            <- NM.toList $ LF.intCoImplements $ LF.qualObject interfaceInfo
+        ]
 
-    allExercisedChoices :: S.Set ChoiceIdentifier
-    allExercisedChoices = foldMap (exercisedChoices . snd) results
+    allCreatedContracts :: M.Map ContractIdentifier [LocalOrExternal]
+    allCreatedContracts = M.unionsWith (<>) $ map (uncurry createdContracts) results
 
-    createdTemplates :: [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> S.Set TemplateIdentifier
-    createdTemplates results =
-        S.fromList $
-        [ ssIdentifierToIdentifier identifier
+    allExercisedChoices :: M.Map ChoiceIdentifier [LocalOrExternal]
+    allExercisedChoices = M.unionsWith (<>) $ map (uncurry exercisedChoices) results
+
+    createdContracts :: LocalOrExternal -> [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> M.Map ContractIdentifier [LocalOrExternal]
+    createdContracts loe results =
+        M.fromList $
+        [ (ssIdentifierToIdentifier identifier, [loe])
         | n <- scenarioNodes results
         , Just (SS.NodeNodeCreate SS.Node_Create {SS.node_CreateContractInstance}) <-
               [SS.nodeNode n]
@@ -323,15 +427,16 @@ printTestCoverage ShowCoverage {getShowCoverage} allPackages results
         , Just identifier <- [SS.contractInstanceTemplateId contractInstance]
         ]
 
-    exercisedChoices :: [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> S.Set ChoiceIdentifier
-    exercisedChoices results =
-        S.fromList $
-        [ ChoiceIdentifier (ssIdentifierToIdentifier identifier) (TL.toStrict node_ExerciseChoiceId)
+    exercisedChoices :: LocalOrExternal -> [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> M.Map ChoiceIdentifier [LocalOrExternal]
+    exercisedChoices loe results =
+        M.fromList $
+        [ (choiceIdentifier, [loe])
         | n <- scenarioNodes results
         , Just (SS.NodeNodeExercise SS.Node_Exercise { SS.node_ExerciseTemplateId
                                                      , SS.node_ExerciseChoiceId
                                                      }) <- [SS.nodeNode n]
         , Just identifier <- [node_ExerciseTemplateId]
+        , let choiceIdentifier = ChoiceIdentifier (ssIdentifierToIdentifier identifier) (TL.toStrict node_ExerciseChoiceId)
         ]
 
     scenarioNodes :: [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> [SS.Node]
@@ -355,16 +460,16 @@ printTestCoverage ShowCoverage {getShowCoverage} allPackages results
                 | otherwise
                 = Nothing
 
-    printTemplateIdentifier :: TemplateIdentifier -> String
-    printTemplateIdentifier TemplateIdentifier { package, qualifiedTemplate } =
+    printContractIdentifier :: ContractIdentifier -> String
+    printContractIdentifier ContractIdentifier { package, qualifiedName } =
         T.unpack $ maybe
-            qualifiedTemplate
-            (\pId -> pkgIdToPkgName pId <> ":" <> qualifiedTemplate)
+            qualifiedName
+            (\pId -> pkgIdToPkgName pId <> ":" <> qualifiedName)
             package
 
     printChoiceIdentifier :: ChoiceIdentifier -> String
-    printChoiceIdentifier ChoiceIdentifier { packageTemplate, choice } =
-        printTemplateIdentifier packageTemplate <> ":" <> T.unpack choice
+    printChoiceIdentifier ChoiceIdentifier { packageContract, choice } =
+        printContractIdentifier packageContract <> ":" <> T.unpack choice
 
 printScenarioResults :: UseColor -> [(VirtualResource, Either SSC.Error SS.ScenarioResult)] -> IO ()
 printScenarioResults color results = do

compiler/damlc/tests/src/DamlcTest.hs

@@ -319,7 +319,16 @@ testsForDamlcTest damlc scriptDar _ = testGroup "damlc test" $
             exitCode @?= ExitSuccess
             let out = lines stdout
             assertBool ("test coverage is reported correctly: " <> stdout)
-                       ("defined in local modules:\n  choices: 1 / 3 (33%)\n  templates: 1 / 2 (50%)" `isInfixOf` stdout)
+                       ( unlines
+                       [ "Modules internal to this package:"
+                       , "- Internal templates"
+                       , "  2 defined"
+                       , "  1 ( 50.0%) created"
+                       , "- Internal template choices"
+                       , "  3 defined"
+                       , "  1 ( 33.3%) exercised"
+                       ]
+                       `isInfixOf` stdout)
             assertBool ("test summary is reported correctly: " <> out!!1)
                        ("Test Summary" `isPrefixOf` (out!!1))
             assertBool ("test summary is reported correctly: " <> out!!3)
@@ -358,13 +367,18 @@ testsForDamlcTest damlc scriptDar _ = testGroup "damlc test" $
                   ""
             exitCode @?= ExitSuccess
             assertBool
-                ("test coverage is reported correctly: " <> stdout)
+                ("template creation coverage is reported correctly: " <> stdout)
                 (unlines
-                     [ "  templates never created:"
+                     [ "  internal templates never created: 1"
                      , "    Foo:S"
-                     , "  choices never executed:"
+                     ] `isInfixOf`
+                 stdout)
+            assertBool
+                ("template choice coverage is reported correctly: " <> stdout)
+                (unlines
+                     [ "  internal template choices never exercised: 2"
                      , "    Foo:S:Archive"
-                     , "    Foo:T:Archive\n"
+                     , "    Foo:T:Archive"
                      ] `isInfixOf`
                  stdout)
 -- TODO: https://github.com/digital-asset/daml/issues/13044
@@ -511,16 +525,37 @@ testsForDamlcTest damlc scriptDar _ = testGroup "damlc test" $
                  , "a:testA: ok, 0 active contracts, 2 transactions."
                  ] `isInfixOf`
              stdout)
-          assertBool ("Test coverage is reported correctly: " <> stdout)
+          assertBool ("Internal module test coverage is reported correctly: " <> stdout)
             (unlines
-                 [ "defined anywhere:"
-                 , "  choices: 2 / 5 (40%)"
-                 , "  templates: 2 / 3 (67%)"
-                 , "  templates never created:"
+                 [ "Modules internal to this package:"
+                 , "- Internal templates"
+                 , "  2 defined"
+                 , "  1 ( 50.0%) created"
+                 , "  internal templates never created: 1"
                  , "    B:S"
-                 , "  choices never executed:"
+                 , "- Internal template choices"
+                 , "  3 defined"
+                 , "  1 ( 33.3%) exercised"
+                 , "  internal template choices never exercised: 2"
                  , "    B:S:Archive"
                  , "    B:T:Archive"
+                 ] `isInfixOf`
+             stdout)
+          assertBool ("External module test coverage is reported correctly: " <> stdout)
+            (unlines
+                 [ "Modules external to this package:"
+                 , "- External templates"
+                 , "  1 defined"
+                 , "  1 (100.0%) created in any tests"
+                 , "  0 (  0.0%) created in internal tests"
+                 , "  1 (100.0%) created in external tests"
+                 , "  external templates never created: 0"
+                 , "- External template choices"
+                 , "  2 defined"
+                 , "  1 ( 50.0%) exercised in any tests"
+                 , "  0 (  0.0%) exercised in internal tests"
+                 , "  1 ( 50.0%) exercised in external tests"
+                 , "  external template choices never exercised: 1"
                  , "    a:A:U:Archive"
                  ] `isInfixOf`
              stdout)
@@ -579,9 +614,13 @@ testsForDamlcTest damlc scriptDar _ = testGroup "damlc test" $
             (unlines
               ["B.daml:needleHaystack: ok, 0 active contracts, 0 transactions."
               , "a:test_needleHaystack: ok, 0 active contracts, 0 transactions."
-              , "defined in local modules:"
-              , "  choices: 0 / 0 (100%)"
-              , "  templates: 0 / 0 (100%)"
+              , "Modules internal to this package:"
+              , "- Internal templates"
+              , "  0 defined"
+              , "  0 (100.0%) created"
+              , "- Internal template choices"
+              , "  0 defined"
+              , "  0 (100.0%) exercised"
               ] `isInfixOf` stdout)
           exitCode @?= ExitSuccess
     , testCase "Full test coverage report without --all set (but imports)" $ withTempDir $ \projDir -> do
@@ -649,14 +688,18 @@ testsForDamlcTest damlc scriptDar _ = testGroup "damlc test" $
           assertBool ("Test coverage is reported correctly: " <> stdout)
             (unlines
                  [ "B.daml:x: ok, 0 active contracts, 2 transactions."
-                 , "defined in local modules:"
-                 , "  choices: 1 / 3 (33%)"
-                 , "  templates: 1 / 2 (50%)"
-                 , "  templates never created:"
+                 , "Modules internal to this package:"
+                 , "- Internal templates"
+                 , "  2 defined"
+                 , "  1 ( 50.0%) created"
+                 , "  internal templates never created: 1"
                  , "    B:S"
-                 , "  choices never executed:"
+                 , "- Internal template choices"
+                 , "  3 defined"
+                 , "  1 ( 33.3%) exercised"
+                 , "  internal template choices never exercised: 2"
                  , "    B:S:Archive"
-                 , "    B:T:Archive\n"
+                 , "    B:T:Archive"
                  ] `isInfixOf`
              stdout)
           exitCode @?= ExitSuccess