extend visual for exerciseByKey (#5739)

* extend visual for exerciseByKey

Fair warning: I have no idea what I'm doing here. Please review
carefully.

This commit extends the `daml damlc visual` command to draw a line for
exerciseByKey choices. This fixes #5726.

I have not been able to find any existing test for the visualizer. If
non exist, I think we should at least turn #5726 into a test case,
checking that the expected dot file gets generated. I suggest doing that
as a separate PR though.

If there is already a suite of tests, please point me to it and I'll
happily add one for this.

CHANGELOG_BEGIN
[Visualization] Fix a bug where `exerciseByKey` was not properly
recognized. See #5726.
CHANGELOG_END

* add test
This commit is contained in:
Gary Verhaegen 2020-04-27 18:51:40 +02:00 committed by GitHub
parent effd05b894
commit b2fc953250
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 53 additions and 0 deletions

View File

@ -175,6 +175,8 @@ startFromExpr seen world e = case e of
-- instance and produce the corresponding edge in the graph.
EInternalTemplateVal "exercise" `LF.ETyApp` LF.TCon tpl `LF.ETyApp` LF.TCon (LF.Qualified _ _ (LF.TypeConName [chc])) `LF.ETyApp` _ret `LF.ETmApp` _dict ->
Set.singleton (AExercise tpl (LF.ChoiceName chc))
EInternalTemplateVal "exerciseByKey" `LF.ETyApp` LF.TCon tpl `LF.ETyApp` _ `LF.ETyApp` LF.TCon (LF.Qualified _ _ (LF.TypeConName [chc])) `LF.ETyApp` _ret `LF.ETmApp` _dict ->
Set.singleton (AExercise tpl (LF.ChoiceName chc))
expr -> Set.unions $ map (startFromExpr seen world) $ children expr
pattern EInternalTemplateVal :: T.Text -> LF.Expr

View File

@ -1253,6 +1253,57 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
ExpectedChoiceDetails {expectedConsuming = True
, expectedName = "Delete"})
])
-- test case taken from #5726
, testCase' "ExerciseByKey should add an edge" $ do
exerciseByKeyTest <- makeModule "F"
[ "template Ping"
, " with"
, " party : Party"
, " where"
, " signatory party"
, " key party: Party"
, " maintainer key"
, ""
, " controller party can"
, " nonconsuming ArchivePong : ()"
, " with"
, " pong : ContractId Pong"
, " do"
, " exercise pong Archive"
, ""
, "template Pong"
, " with"
, " party : Party"
, " where"
, " signatory party"
, ""
, " controller party can"
, " nonconsuming ArchivePing : ()"
, " with"
, " pingParty : Party"
, " do"
, " exerciseByKey @Ping pingParty Archive"
]
setFilesOfInterest [exerciseByKeyTest]
expectNoErrors
expectedGraph exerciseByKeyTest (ExpectedGraph
[ ExpectedSubGraph { expectedNodes = ["Create", "ArchivePong", "Archive"]
, expectedTplFields = ["party"]
, expectedTemplate = "Ping"
}
, ExpectedSubGraph { expectedNodes = ["Create", "Archive", "ArchivePing"]
, expectedTplFields = ["party"]
, expectedTemplate = "Pong"}
]
[ (ExpectedChoiceDetails {expectedConsuming = False
, expectedName = "ArchivePong"},
ExpectedChoiceDetails {expectedConsuming = True
, expectedName = "Archive"})
, (ExpectedChoiceDetails {expectedConsuming = False
, expectedName = "ArchivePing"},
ExpectedChoiceDetails {expectedConsuming = True
, expectedName = "Archive"})
])
, testCase' "Create on other template should be edge" $ do
createTest <- makeModule "F"
[ "template TT"