2 puts "0031770: To add tests of Abort command to 31748"
5 # This test checks different combinations of creation/modification/forget of attributes in
6 # transactions and Abort: when there are one or two attributes on a label, on father and child labels.
11 # enumeration of actions: first come actions where no attribute needed on the label, after none, after - attribute must be on the label
13 set act_createforget 1
14 set act_createmodify 2
17 set act_modifyforget 5
19 set act_forgetcreate 7
20 # the number of possible actions that can be done on attribute
23 set act_afternone [expr $act_none+1]
25 # retuns 1 if after this action there exists attribute on the label
26 proc produces_attribute1 {action} {
27 global act_create act_modify act_forgetcreate act_createmodify
28 if {$action==$act_create || $action==$act_createmodify || $action==$act_modify || $action==$act_forgetcreate} {
34 # retuns 1 if after two actions there exists attribute on the label
35 proc produces_attribute2 {action1 action2} {
36 global act_create act_modify act_modifyforget act_forget act_createforget
37 if {[produces_attribute1 $action2]} {
40 if {$action2!=$act_forget && $action2!=$act_createforget && $action2!=$act_modifyforget && [produces_attribute1 $action1]} {
46 # retuns value of the attribute produced by two actions
47 proc produces_value {action1 action2} {
48 global act_modify act_createmodify act_none act_forgetcreate
49 if {$action2==$act_modify} {
50 if {$action1==$act_createmodify} {
55 if {$action2==$act_createmodify} {
58 if {$action1==$act_createmodify && $action2!=$act_forgetcreate} {
61 if {$action1==$act_none && $action1==$act_createmodify} {
67 proc attribute_name attr_id {
74 proc do_action {label attr action} {
76 set attrName [attribute_name $attr]
77 switch $action { # first there are atcions that leave attribute, then - none, then - that remove it
78 0 { # sets a new attribute
79 Set$attrName D $label 1
81 1 { # creates and immediately forgets a new attribute
82 Set$attrName D $label 1
83 if $attr==0 { # forget integer
84 ForgetAtt D $label 2a96b606-ec8b-11d0-bee7-080009dc3333
85 } else { # forget real
86 ForgetAtt D $label 2a96b60f-ec8b-11d0-bee7-080009dc3333
89 2 { # sets and modifies attribute
90 Set$attrName D $label 1
91 Set$attrName D $label 2
95 4 { # modifies (increments) an attribute value if it is already exists on this label
96 set value [Get$attrName D $label]
97 Set$attrName D $label [expr $value+1]
99 5 { # modifies and immediately forgets an attribute
100 set value [Get$attrName D $label]
101 Set$attrName D $label [expr $value+1]
102 if $attr==0 { # forget integer
103 ForgetAtt D $label 2a96b606-ec8b-11d0-bee7-080009dc3333
104 } else { # forget real
105 ForgetAtt D $label 2a96b60f-ec8b-11d0-bee7-080009dc3333
108 6 { # forgets the attribute
109 if $attr==0 { # forget integer
110 ForgetAtt D $label 2a96b606-ec8b-11d0-bee7-080009dc3333
111 } else { # forget real
112 ForgetAtt D $label 2a96b60f-ec8b-11d0-bee7-080009dc3333
115 7 { # forgets and immediately creates an attribute
116 if $attr==0 { # forget integer
117 ForgetAtt D $label 2a96b606-ec8b-11d0-bee7-080009dc3333
118 } else { # forget real
119 ForgetAtt D $label 2a96b60f-ec8b-11d0-bee7-080009dc3333
121 Set$attrName D $label 1
126 proc check_attribute {action1 action2 lab attr} {
128 set attrName [attribute_name $attr]
129 if [produces_attribute2 $action1 $action2] {
130 set value [Get$attrName D $lab]
131 set expected_value [produces_value $action1 $action2]
132 if $value!=$expected_value {
133 puts "Error : attribute $attrName value $value does not match the expected $expected_value at the label $lab"
136 set attributes [Attributes D $lab]
137 if {[lsearch $attributes TDataStd_$attrName]>=0} {
138 puts "Error : attribute $attrName exists but it should not at the label $lab"
146 # cycles by variables t<transaction number>l<label number>a<attribute number> = action id
147 for {set t1l1a1 0} {$t1l1a1 < $act_afternone} {incr t1l1a1} {
148 for {set t1l2a1 0} {$t1l2a1 < $act_afternone} {incr t1l2a1} {
149 for {set t1l2a2 0} {$t1l2a2 < $act_afternone} {incr t1l2a2} {
151 set t2l1a1_max $actions
152 if [produces_attribute1 $t1l1a1] {set t2l1a1_min $act_none} {set t2l1a1_max $act_afternone}
153 for {set t2l1a1 $t2l1a1_min} {$t2l1a1 < $t2l1a1_max} {incr t2l1a1} {
155 set t2l2a1_max $actions
156 if [produces_attribute1 $t1l2a1] {set t2l2a1_min $act_none} {set t2l2a1_max $act_afternone}
157 for {set t2l2a1 $t2l2a1_min} {$t2l2a1 < $t2l2a1_max} {incr t2l2a1} {
159 set t2l2a2_max $actions
160 if [produces_attribute1 $t1l2a2] {set t2l2a2_min $act_none} {set t2l2a2_max $act_afternone}
161 for {set t2l2a2 $t2l2a2_min} {$t2l2a2 < $t2l2a2_max} {incr t2l2a2} {
162 set lab [Label D 0:$lab_index]
164 set sublab [Label D $lab:1]
168 # avoid creation of too many labels (which is too slow)
173 do_action $lab 0 $t1l1a1
174 do_action $sublab 0 $t1l2a1
175 do_action $sublab 1 $t1l2a2
178 do_action $lab 0 $t2l1a1
179 do_action $sublab 0 $t2l2a1
180 do_action $sublab 1 $t2l2a2
181 # check all attributes are correctly located in the tree
182 check_attribute $t1l1a1 $t2l1a1 $lab 0
183 check_attribute $t1l2a1 $t2l2a1 $sublab 0
184 check_attribute $t1l2a2 $t2l2a2 $sublab 1
185 # check attributes state after Abort
187 check_attribute $act_none $t1l1a1 $lab 0
188 check_attribute $act_none $t1l2a1 $sublab 0
189 check_attribute $act_none $t1l2a2 $sublab 1
196 puts "Checked $num_variants variants"