mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
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:
parent
effd05b894
commit
b2fc953250
@ -175,6 +175,8 @@ startFromExpr seen world e = case e of
|
|||||||
-- instance and produce the corresponding edge in the graph.
|
-- 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 ->
|
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))
|
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
|
expr -> Set.unions $ map (startFromExpr seen world) $ children expr
|
||||||
|
|
||||||
pattern EInternalTemplateVal :: T.Text -> LF.Expr
|
pattern EInternalTemplateVal :: T.Text -> LF.Expr
|
||||||
|
@ -1253,6 +1253,57 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
|
|||||||
ExpectedChoiceDetails {expectedConsuming = True
|
ExpectedChoiceDetails {expectedConsuming = True
|
||||||
, expectedName = "Delete"})
|
, 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
|
, testCase' "Create on other template should be edge" $ do
|
||||||
createTest <- makeModule "F"
|
createTest <- makeModule "F"
|
||||||
[ "template TT"
|
[ "template TT"
|
||||||
|
Loading…
Reference in New Issue
Block a user