Skip to content

Commit dcc96ff

Browse files
authored
Lucretius x update (continued) (#2)
* Add ‘create' for instantiation statements (avoid unknown/create).
1 parent 32d64d2 commit dcc96ff

12 files changed

+292
-291
lines changed

Activity/activity.xotcl

+54-54
Large diffs are not rendered by default.

Activity/ba_break-glass.xotcl

+78-78
Large diffs are not rendered by default.

Activity/business_activity.xotcl

+105-105
Large diffs are not rendered by default.

Activity/tests/01-business-activity-roles.test.xotcl

+1-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
21
::STORM::TestCase BA_RBAC_Roles \
32
-setup_script {
43
::UML2::BusinessActivity::RBACModel ::rbac
@@ -357,4 +356,4 @@ BA_RBAC_Roles::AddJuniorRelationFail2 postconditions assign\
357356
{my lequal [::rbac::edges::roletoroleassignment3 target] D }\
358357
{my lequal [::rbac::edges::roletoroleassignment3 target_type] ::UML2::BusinessActivity::Role}\
359358
}
360-
BA_RBAC_Roles order add BA_RBAC_Roles::AddJuniorRelationFail2 end
359+
BA_RBAC_Roles order add BA_RBAC_Roles::AddJuniorRelationFail2 end

Activity/tests/18-business-activity-allocate.test.xotcl

+3-3
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
::STORM::TestCase BA_Allocate \
33
-setup_script {
44
my resetAllAutonames ::xotcl::Object
5-
::UML2::BusinessActivity ::process
5+
::UML2::BusinessActivity create ::process
66
::process addNode ::UML2::InitialNode Start
77
::process addNode ::UML2::BusinessAction A
88
::process addNode ::UML2::BusinessAction B
@@ -43,7 +43,7 @@
4343
::process setDMEConstraint B C
4444
::process setDMEConstraint C D
4545

46-
::UML2::BusinessActivity::RBACModel ::rbacmodel
46+
::UML2::BusinessActivity::RBACModel create ::rbacmodel
4747
::process associated_rbac_model ::rbacmodel
4848
::rbacmodel addSubject Catherine
4949
::rbacmodel addSubject Monica
@@ -69,7 +69,7 @@
6969
::rbacmodel setActiveRole Monica R1
7070
::rbacmodel setActiveRole Sophie R3
7171
::rbacmodel setActiveRole Catherine R3
72-
::process ::myProcessInstance -initiating_subject Mark
72+
::process create ::myProcessInstance -initiating_subject Mark
7373
} \
7474
-cleanup_script {
7575
::process destroy

Activity/tests/21-business-activity-break-glass-bbr-allocate.test.xotcl

+4-4
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,8 @@
44
my resetAllAutonames ::xotcl::Object
55
package require -exact UML2::BusinessActivity::BreakGlass 0.1.1
66

7-
::UML2::BusinessActivity ::process
8-
::UML2::BusinessActivity ::reviewprocess
7+
::UML2::BusinessActivity create ::process
8+
::UML2::BusinessActivity create ::reviewprocess
99
::process addNode ::UML2::InitialNode Start
1010
::process addNode ::UML2::BusinessAction T1
1111
::process addNode ::UML2::BusinessAction T2
@@ -108,7 +108,7 @@
108108
}
109109

110110
::STORM::TestScenario BA_BG_BBR_Allocate::InstantiateSuccess \
111-
-test_body {::process ::myProcessInstance}\
111+
-test_body {::process create ::myProcessInstance}\
112112
-expected_result ::myProcessInstance
113113
BA_BG_BBR_Allocate::InstantiateSuccess preconditions assign\
114114
{ {my lequal [::UML2::BusinessActivity info instmixin] ::UML2::BusinessActivity::BreakGlassExtension}
@@ -7344,7 +7344,7 @@ BA_BG_BBR_Allocate order add BA_BG_BBR_Allocate::UnbreakTaskFail end
73447344
::rbacmodel setActiveRole Sophie R3
73457345
::rbacmodel setActiveRole Joanne R4
73467346

7347-
::process ::myProcessInstance
7347+
::process create ::myProcessInstance
73487348
::myProcessInstance review_process_type ::reviewprocess
73497349
} \
73507350
-cleanup_script {

Activity/tests/22-business-activity-break-glass-bbs-allocate.test.xotcl

+8-8
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,8 @@
33
my resetAllAutonames ::xotcl::Object
44
package require -exact UML2::BusinessActivity::BreakGlass 0.1.1
55

6-
::UML2::BusinessActivity ::process
7-
::UML2::BusinessActivity ::reviewprocess
6+
::UML2::BusinessActivity create ::process
7+
::UML2::BusinessActivity create ::reviewprocess
88
::process addNode ::UML2::InitialNode Start
99
::process addNode ::UML2::BusinessAction T1
1010
::process addNode ::UML2::BusinessAction T2
@@ -61,7 +61,7 @@
6161
::process setRoleBinding T7 T8
6262
::process setRoleBinding T8 T9
6363

64-
::UML2::BusinessActivity::RBACModel ::rbacmodel
64+
::UML2::BusinessActivity::RBACModel create ::rbacmodel
6565
::process associated_rbac_model ::rbacmodel
6666
::rbacmodel addRole R1
6767
::rbacmodel addRole R2
@@ -102,7 +102,7 @@
102102
::rbacmodel setActiveRole Sophie R3
103103
::rbacmodel setActiveRole Joanne R4
104104

105-
::process ::myProcessInstance
105+
::process create ::myProcessInstance
106106
::myProcessInstance review_process_type ::reviewprocess
107107
} \
108108
-cleanup_script {
@@ -1973,8 +1973,8 @@ BA_BG_BBS_Allocate order add BA_BG_BBS_Allocate::BGAllocateSuccess3 end
19731973
my resetAllAutonames ::xotcl::Object
19741974
package require -exact UML2::BusinessActivity::BreakGlass 0.1.1
19751975

1976-
::UML2::BusinessActivity ::process
1977-
::UML2::BusinessActivity ::reviewprocess
1976+
::UML2::BusinessActivity create ::process
1977+
::UML2::BusinessActivity create ::reviewprocess
19781978
::process addNode ::UML2::InitialNode Start
19791979
::process addNode ::UML2::BusinessAction T1
19801980
::process addNode ::UML2::BusinessAction T2
@@ -2031,7 +2031,7 @@ BA_BG_BBS_Allocate order add BA_BG_BBS_Allocate::BGAllocateSuccess3 end
20312031
::process setRoleBinding T7 T8
20322032
::process setRoleBinding T8 T9
20332033

2034-
::UML2::BusinessActivity::RBACModel ::rbacmodel
2034+
::UML2::BusinessActivity::RBACModel create ::rbacmodel
20352035
::process associated_rbac_model ::rbacmodel
20362036
::rbacmodel addRole R1
20372037
::rbacmodel addRole R2
@@ -2072,7 +2072,7 @@ BA_BG_BBS_Allocate order add BA_BG_BBS_Allocate::BGAllocateSuccess3 end
20722072
::rbacmodel setActiveRole Sophie R3
20732073
::rbacmodel setActiveRole Joanne R4
20742074

2075-
::process ::myProcessInstance
2075+
::process create ::myProcessInstance
20762076
::myProcessInstance review_process_type ::reviewprocess
20772077
} \
20782078
-cleanup_script {

Activity/tests/23-business-activity-break-glass-random-allocate.test.xotcl

+5-5
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,8 @@
33
my resetAllAutonames ::xotcl::Object
44
package require -exact UML2::BusinessActivity::BreakGlass 0.1.1
55

6-
::UML2::BusinessActivity ::process
7-
::UML2::BusinessActivity ::reviewprocess
6+
::UML2::BusinessActivity create ::process
7+
::UML2::BusinessActivity create ::reviewprocess
88
::process addNode ::UML2::InitialNode Start
99
::process addNode ::UML2::BusinessAction T1
1010
::process addNode ::UML2::BusinessAction T2
@@ -61,7 +61,7 @@
6161
::process setRoleBinding T7 T8
6262
::process setRoleBinding T8 T9
6363

64-
::UML2::BusinessActivity::RBACModel ::rbacmodel
64+
::UML2::BusinessActivity::RBACModel create ::rbacmodel
6565
::process associated_rbac_model ::rbacmodel
6666
::rbacmodel addRole R1
6767
::rbacmodel addRole R2
@@ -103,7 +103,7 @@
103103
::rbacmodel setActiveRole Joanne R4
104104

105105
::process addNode ::UML2::BusinessAction T11
106-
::process ::myProcessInstance
106+
::process create ::myProcessInstance
107107
::myProcessInstance review_process_type ::reviewprocess
108108
} \
109109
-cleanup_script {
@@ -1696,7 +1696,7 @@ BA_BG_BBS_Random_Allocate order add BA_BG_BBS_Random_Allocate::BGReAllocateSucce
16961696
::rbacmodel setActiveRole Joanne R4
16971697

16981698
::process addNode ::UML2::BusinessAction T11
1699-
::process ::myProcessInstance
1699+
::process create ::myProcessInstance
17001700
::myProcessInstance review_process_type ::reviewprocess
17011701
} \
17021702
-cleanup_script {

Activity/tests/activity-testsuite.xotcl

+1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ set auto_path ".. ../.. $auto_path"
22

33
package require STORM 0.5
44

5+
56
# eliminate dublicate list elements while retaining element order
67
proc luniqueorder {list} {
78
set nl ""

Graph/graph.xotcl

+25-24
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@
33
#
44
#(c) Mark Strembeck
55
#
6-
# Most UML models/diagrams are essentially graphs (e.g.
6+
# Most UML models/diagrams are essentially graphs (e.g.
77
# activity diagrams, class diagrams, state machines, etc.).
88
# UML2::Graph is a convenience package to provide a basic
9-
# graph structure for other UML2 packages. Therefore,
9+
# graph structure for other UML2 packages. Therefore,
1010
# UML2::Graph instances are not intended to exist as
1111
# standalone objects, but provide the base structure
1212
# for packages that define actual UML2 models.
@@ -21,9 +21,8 @@ package require MSXOLIB
2121

2222
namespace eval ::UML2 {
2323

24-
Object ::UML2::resultobjects
2524

26-
Class Graph -slots {
25+
Class create Graph -slots {
2726
::msxolib::SingleValued name
2827
::msxolib::OrderedSet valid_node_types
2928
::msxolib::OrderedSet valid_edge_types
@@ -38,10 +37,11 @@ Graph instproc init args {
3837

3938
Graph instproc addNode {type {name ""}} {
4039
if {![my isValidNodeType $type]} {
41-
return [::msxolib::FunctionResult [::xotcl::Object autoname result] -success 0\
40+
return [::msxolib::FunctionResult create [::xotcl::Object autoname result] -success 0\
4241
-comment "[my info class] [self] [self proc] FAILED, << $type >> is not a valid node type\
43-
for [my info class]."]
44-
}
42+
for [my info class]."]
43+
44+
}
4545
if {$name eq ""} {
4646
set new [$type [::xotcl::Object autoname [self]::nodes::[string tolower [namespace tail $type]]]]
4747
$new name [namespace tail $new]
@@ -51,15 +51,16 @@ Graph instproc addNode {type {name ""}} {
5151
set new [$type [::xotcl::Object autoname [self]::nodes::[string tolower [namespace tail $type]]]]
5252
$new name $name
5353
} else {
54-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
54+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
5555
-comment "[my info class] [self] [self proc] FAILED, $type with name << $name >>\
5656
already exists in [my info class] << [my name] >>."]
57-
}
57+
58+
}
5859
}
5960
$new owning_graph [self]
6061
# here [string tolower [namespace tail $type]] determines an array name
6162
my set [string tolower [namespace tail $type]]([$new name]) $new
62-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
63+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
6364
-object_name [$new name] -object_reference $new\
6465
-comment "[my info class] [self] [self proc], successfully added $type << [$new name] >>\
6566
to [my info class] << [my name] >>."]
@@ -74,20 +75,20 @@ Graph instproc isValidNodeType {type} {
7475

7576
Graph instproc addEdge {edgeType fromType from toType to {name ""}} {
7677
if {![my isValidEdgeType $edgeType]} {
77-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
78+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
7879
-comment "[my info class] [self] [self proc] FAILED, << $edgeType >> is not a valid edge type\
7980
for [my info class]."]
8081
}
8182
foreach t "$fromType $toType" n "$from $to" {
8283
if {![my existNode $t $n]} {
83-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
84+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
8485
-comment "[my info class] [self] [self proc] FAILED, $t node << $n >> does not exist\
8586
in [my info class] << [my name] >>."]
8687
}
8788
}
8889
set constructioncheck [my checkGraphConstructionRules $edgeType $fromType $from $toType $to]
89-
if {![$constructioncheck success]} {
90-
return $constructioncheck
90+
if {![$constructioncheck success]} {
91+
return $constructioncheck
9192
}
9293
if {$name eq ""} {
9394
set new [$edgeType [::xotcl::Object autoname [self]::edges::[string tolower [namespace tail $edgeType]]]]
@@ -98,7 +99,7 @@ Graph instproc addEdge {edgeType fromType from toType to {name ""}} {
9899
set new [$edgeType [::xotcl::Object autoname [self]::edges::[string tolower [namespace tail $edgeType]]]]
99100
$new name $name
100101
} else {
101-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
102+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 0\
102103
-comment "[my info class] [self] [self proc] FAILED, $edgeType with name << $name >>\
103104
already exists in [my info class] << [my name] >>."]
104105
}
@@ -112,14 +113,14 @@ Graph instproc addEdge {edgeType fromType from toType to {name ""}} {
112113
my set [string tolower [namespace tail $edgeType]]([$new name]) $new
113114
[my getFQON $fromType $from] outgoing add $new
114115
[my getFQON $toType $to] incoming add $new
115-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
116+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
116117
-object_name [$new name] -object_reference $new\
117118
-comment "[my info class] [self] [self proc], successfully added $edgeType << [$new name] >>\
118119
to [my info class] << [my name] >>."]
119120
}
120121

121122
Graph instproc checkGraphConstructionRules {edgeType fromType from toType to} {
122-
return [::msxolib::FunctionResult [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
123+
return [::msxolib::FunctionResult create [::xotcl::Object autoname ::UML2::resultobjects::result] -success 1\
123124
-comment "[my info class] [self] [self proc], no specific construction rules for [my info class] graphs."]
124125
}
125126

@@ -158,16 +159,16 @@ Graph instproc getFQON {type name} {
158159
return ""
159160
}
160161

161-
Class Graph::Node -slots {
162+
Class create Graph::Node -slots {
162163
::msxolib::SingleValued name
163164
::msxolib::SingleValued owning_graph
164165
}
165-
Class Graph::Node::SingleIn -slots {::msxolib::SingleValued incoming}
166-
Class Graph::Node::SingleOut -slots {::msxolib::SingleValued outgoing}
167-
Class Graph::Node::MultiIn -slots {::msxolib::OrderedSet incoming}
168-
Class Graph::Node::MultiOut -slots {::msxolib::OrderedSet outgoing}
166+
Class create Graph::Node::SingleIn -slots {::msxolib::SingleValued incoming}
167+
Class create Graph::Node::SingleOut -slots {::msxolib::SingleValued outgoing}
168+
Class create Graph::Node::MultiIn -slots {::msxolib::OrderedSet incoming}
169+
Class create Graph::Node::MultiOut -slots {::msxolib::OrderedSet outgoing}
169170

170-
Class Graph::Edge -slots {
171+
Class create Graph::Edge -slots {
171172
::msxolib::SingleValued name
172173
::msxolib::SingleValued source
173174
::msxolib::SingleValued target
@@ -180,4 +181,4 @@ Class Graph::Edge -slots {
180181

181182

182183
}
183-
# ::UML2 namespace ends here
184+
# ::UML2 namespace ends here

MSXOLIB/msxolib.xotcl

+3-3
Original file line numberDiff line numberDiff line change
@@ -66,13 +66,13 @@ SingleValued instproc add {domain var value} {
6666
# object_reference = fully-qualified object name
6767
# comment = a human-readable comment
6868

69-
::xotcl::Class FunctionResult -slots {
69+
::xotcl::Class create FunctionResult -slots {
7070
Attribute success -default {}
7171
Attribute result -default {}
7272
Attribute object_name -default {}
7373
Attribute object_reference -default {}
7474
Attribute comment -default {}
7575
}
7676

77-
}
78-
# ::msxolib namespace ends here
77+
}
78+
# ::msxolib namespace ends here

STORM/storm.xotcl

+5-5
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ namespace eval ::STORM {
1717
#################
1818
# Class TestSuite
1919
#################
20-
Class TestSuite -slots {
20+
Class create TestSuite -slots {
2121
Attribute setup_script
2222
Attribute cleanup_script
2323
Attribute detailed_report -default 0
@@ -175,7 +175,7 @@ namespace eval ::STORM {
175175
################
176176
# Class TestCase
177177
################
178-
Class TestCase -slots {
178+
Class create TestCase -slots {
179179
Attribute setup_script
180180
Attribute preconditions -default "" -multivalued true
181181
Attribute postconditions -default "" -multivalued true
@@ -288,7 +288,7 @@ namespace eval ::STORM {
288288
####################
289289
# Class TestScenario
290290
####################
291-
Class TestScenario -slots {
291+
Class create TestScenario -slots {
292292
Attribute test_body
293293
Attribute expected_result
294294
Attribute preconditions -default "" -multivalued true
@@ -389,7 +389,7 @@ namespace eval ::STORM {
389389
##############
390390
# Class Report
391391
##############
392-
Class Report -slots {
392+
Class create Report -slots {
393393
Attribute detailed -default 0
394394
}
395395

@@ -424,7 +424,7 @@ namespace eval ::STORM {
424424
##################
425425
# Class TestResult
426426
##################
427-
Class TestResult -slots {
427+
Class create TestResult -slots {
428428
Attribute success -default {}
429429
Attribute object_name -default {}
430430
Attribute object_reference -default {}

0 commit comments

Comments
 (0)