1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1997-2020. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20 21%% 22-module(mnesia_isolation_test). 23-author('hakan@erix.ericsson.se'). 24 25-export([init_per_testcase/2, end_per_testcase/2, 26 init_per_group/2, end_per_group/2, 27 all/0, groups/0]). 28 29-export([no_conflict/1, simple_queue_conflict/1, 30 advanced_queue_conflict/1, simple_deadlock_conflict/1, 31 advanced_deadlock_conflict/1, schema_deadlock/1, lock_burst/1, 32 nasty/1, basic_sticky_functionality/1, sticky_sync/1, 33 unbound1/1, unbound2/1, 34 create_table/1, delete_table/1, move_table_copy/1, 35 add_table_index/1, del_table_index/1, transform_table/1, 36 snmp_open_table/1, snmp_close_table/1, 37 change_table_copy_type/1, change_table_access/1, 38 add_table_copy/1, del_table_copy/1, dump_tables/1, 39 del_table_copy_1/1, del_table_copy_2/1, del_table_copy_3/1, 40 add_table_copy_1/1, add_table_copy_2/1, add_table_copy_3/1, 41 add_table_copy_4/1, move_table_copy_1/1, move_table_copy_2/1, 42 move_table_copy_3/1, move_table_copy_4/1, 43 dirty_updates_visible_direct/1, 44 dirty_reads_regardless_of_trans/1, 45 trans_update_invisibible_outside_trans/1, 46 trans_update_visible_inside_trans/1, write_shadows/1, 47 delete_shadows/1, write_delete_shadows_bag/1, 48 write_delete_shadows_bag2/1, 49 shadow_search/1, snmp_shadows/1, 50 rr_kill_copy/1, foldl/1, first_next/1]). 51 52-export([do_fun/4, burst_counter/3, burst_incr/2, get_held/0, get_info/1, 53 get_sticky/0, op/4, update_own/3, update_shared/3]). 54 55-include("mnesia_test_lib.hrl"). 56 57init_per_testcase(Func, Conf) -> 58 mnesia_test_lib:init_per_testcase(Func, Conf). 59 60end_per_testcase(Func, Conf) -> 61 mnesia_test_lib:end_per_testcase(Func, Conf). 62 63%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 64all() -> 65 [{group, locking}, {group, visibility}]. 66 67groups() -> 68 [{locking, [], 69 [no_conflict, simple_queue_conflict, 70 advanced_queue_conflict, simple_deadlock_conflict, 71 advanced_deadlock_conflict, schema_deadlock, lock_burst, 72 {group, sticky_locks}, {group, unbound_locking}, 73 {group, admin_conflict}, nasty]}, 74 {sticky_locks, [], 75 [basic_sticky_functionality,sticky_sync]}, 76 {unbound_locking, [], [unbound1, unbound2]}, 77 {admin_conflict, [], 78 [create_table, delete_table, move_table_copy, 79 add_table_index, del_table_index, transform_table, 80 snmp_open_table, snmp_close_table, 81 change_table_copy_type, change_table_access, 82 add_table_copy, del_table_copy, dump_tables, 83 {group, extra_admin_tests}]}, 84 {extra_admin_tests, [], 85 [del_table_copy_1, del_table_copy_2, del_table_copy_3, 86 add_table_copy_1, add_table_copy_2, add_table_copy_3, 87 add_table_copy_4, move_table_copy_1, move_table_copy_2, 88 move_table_copy_3, move_table_copy_4]}, 89 {visibility, [], 90 [dirty_updates_visible_direct, 91 dirty_reads_regardless_of_trans, 92 trans_update_invisibible_outside_trans, 93 trans_update_visible_inside_trans, write_shadows, 94 delete_shadows, write_delete_shadows_bag, 95 write_delete_shadows_bag2, {group, iteration}, 96 shadow_search, snmp_shadows]}, 97 {removed_resources, [], [rr_kill_copy]}, 98 {iteration, [], [foldl, first_next]}]. 99 100init_per_group(_GroupName, Config) -> 101 Config. 102 103end_per_group(_GroupName, Config) -> 104 Config. 105 106 107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 108 109 110%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 111 112%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 113no_conflict(suite) -> []; 114no_conflict(Config) when is_list(Config) -> 115 [Node1] = ?acquire_nodes(1, Config), 116 Tab = no_conflict, 117 create_conflict_table(Tab, [Node1]), 118 Fun = fun(OtherOid, Lock1, Lock2) -> 119 %% Start two transactions 120 {success, [B, A]} = ?start_activities([Node1, Node1]), 121 ?start_transactions([B, A]), 122 123 A ! fun() -> Lock1(one_oid(Tab)), ok end, 124 ?match_receive({A, ok}), 125 B ! fun() -> Lock2(OtherOid), ok end, 126 ?match_receive({B, ok}), 127 A ! fun() -> mnesia:abort(ok) end, 128 ?match_receive({A, {aborted, ok}}), 129 B ! fun() -> mnesia:abort(ok) end, 130 ?match_receive({B, {aborted, ok}}) 131 end, 132 NoLocks = lock_funs(no_lock, any_granularity), 133 SharedLocks = lock_funs(shared_lock, any_granularity), 134 AnyLocks = lock_funs(any_lock, any_granularity), 135 OneOneFun = fun(Lock1, Lock2) -> Fun(one_oid(Tab), Lock1, Lock2) end, 136 fun_loop(OneOneFun, NoLocks, AnyLocks), 137 fun_loop(OneOneFun, AnyLocks, NoLocks), 138 fun_loop(OneOneFun, SharedLocks, SharedLocks), 139 140 %% Lock different objects 141 OneOtherFun = fun(Lock1, Lock2) -> Fun(other_oid(Tab), Lock1, Lock2) end, 142 OneSharedLocks = lock_funs(shared_lock, one), 143 OneExclusiveLocks = lock_funs(exclusive_lock, one), 144 fun_loop(OneOtherFun, OneSharedLocks, OneExclusiveLocks), 145 fun_loop(OneOtherFun, OneExclusiveLocks, OneSharedLocks), 146 fun_loop(OneOtherFun, OneExclusiveLocks, OneExclusiveLocks), 147 ok. 148 149%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 150simple_queue_conflict(suite) -> []; 151simple_queue_conflict(Config) when is_list(Config) -> 152 [Node1] = ?acquire_nodes(1, Config), 153 Tab = simple_queue_conflict, 154 create_conflict_table(Tab, [Node1]), 155 Fun = fun(OneLock, OtherLock) -> 156 %% Start two transactions 157 {success, [B, A]} = ?start_activities([Node1, Node1]), 158 ?start_transactions([B, A]), 159 160 A ! fun() -> OneLock(one_oid(Tab)), ok end, 161 ?match_receive({A, ok}), 162 B ! fun() -> OtherLock(one_oid(Tab)), ok end, 163 wait_for_lock(B, [Node1], 20), % Max 10 sec 164 A ! end_trans, 165 ?match_multi_receive([{A, {atomic, end_trans}}, {B, ok}]), 166 B ! fun() -> mnesia:abort(ok) end, 167 ?match_receive({B, {aborted, ok}}) 168 end, 169 OneSharedLocks = lock_funs(shared_lock, one), 170 AllSharedLocks = lock_funs(shared_lock, all), 171 OneExclusiveLocks = lock_funs(exclusive_lock, one), 172 AllExclusiveLocks = lock_funs(exclusive_lock, all), 173 fun_loop(Fun, OneExclusiveLocks, OneExclusiveLocks), 174 fun_loop(Fun, AllExclusiveLocks, AllExclusiveLocks), 175 fun_loop(Fun, OneExclusiveLocks, AllExclusiveLocks), 176 fun_loop(Fun, AllExclusiveLocks, OneExclusiveLocks), 177 fun_loop(Fun, OneSharedLocks, AllExclusiveLocks), 178 fun_loop(Fun, AllSharedLocks, OneExclusiveLocks), 179 ok. 180 181wait_for_lock(Pid, Nodes, Retry) -> 182 wait_for_lock(Pid, Nodes, Retry, queue). 183 184wait_for_lock(Pid, _Nodes, 0, queue) -> 185 Queue = mnesia:system_info(lock_queue), 186 ?error("Timeout while waiting for lock on Pid ~p in queue ~p~n", [Pid, Queue]); 187wait_for_lock(Pid, _Nodes, 0, held) -> 188 Held = mnesia:system_info(held_locks), 189 ?error("Timeout while waiting for lock on Pid ~p (held) ~p~n", [Pid, Held]); 190wait_for_lock(Pid, Nodes, N, Where) -> 191 rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), 192 List = case Where of 193 queue -> 194 [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes]; 195 held -> 196 [rpc:call(Node, mnesia, system_info, [held_locks]) || Node <- Nodes] 197 end, 198 Q = lists:append(List), 199 check_q(Pid, Q, Nodes, N, Where). 200 201check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count, _Where) -> ok; 202check_q(Pid, [{_Oid, _Op, {tid,_,Pid}} | _Tail], _N, _Count, _Where) -> ok; 203check_q(Pid, [_ | Tail], N, Count, Where) -> check_q(Pid, Tail, N, Count, Where); 204check_q(Pid, [], N, Count, Where) -> 205 timer:sleep(200), 206 wait_for_lock(Pid, N, Count - 1, Where). 207 208 209%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 210advanced_queue_conflict(suite) -> []; 211advanced_queue_conflict(Config) when is_list(Config) -> 212 [Node1] = ?acquire_nodes(1, Config), 213 Tab = advanced_queue_conflict, 214 create_conflict_table(Tab, [Node1]), 215 OneRec = {Tab, 3, 3}, 216 OneOid = {Tab, 3}, 217 OtherRec = {Tab, 4, 4}, 218 OtherOid = {Tab, 4}, 219 220 %% Start four transactions 221 {success, [D, C, B, A]} = ?start_activities(lists:duplicate(4, Node1)), 222 ?start_transactions([D, C, B, A]), 223 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 224 ?match([], mnesia:system_info(held_locks)), 225 ?match([], mnesia:system_info(lock_queue)), 226 227 %% Acquire some locks 228 A ! fun() -> mnesia:write(OneRec) end, 229 ?match_receive({A, ok}), 230 A ! fun() -> mnesia:read(OneOid) end, 231 ?match_receive({A, [OneRec]}), 232 233 B ! fun() -> mnesia:write(OtherRec) end, 234 ?match_receive({B, ok}), 235 B ! fun() -> mnesia:read(OneOid) end, 236 ?match_receive(timeout), 237 238 C ! fun() -> mnesia:read(OtherOid) end, 239 ?match_receive(timeout), 240 D ! fun() -> mnesia:wread(OtherOid) end, 241 ?match_receive(timeout), 242 243 %% and release them in a certain order 244 A ! end_trans, 245 ?match_multi_receive([{A, {atomic, end_trans}}, {B, [OneRec]}]), 246 B ! end_trans, 247 ?match_multi_receive([{B, {atomic, end_trans}}, {C, [OtherRec]}]), 248 C ! end_trans, 249 ?match_multi_receive([{C, {atomic, end_trans}}, {D, [OtherRec]}]), 250 D ! end_trans, 251 ?match_receive({D, {atomic, end_trans}}), 252 253 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 254 ?match([], mnesia:system_info(held_locks)), 255 ?match([], mnesia:system_info(lock_queue)), 256 ok. 257 258%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 259simple_deadlock_conflict(suite) -> []; 260simple_deadlock_conflict(Config) when is_list(Config) -> 261 [Node1] = ?acquire_nodes(1, Config), 262 Tab = simple_deadlock_conflict, 263 create_conflict_table(Tab, [Node1]), 264 Rec = {Tab, 4, 4}, 265 Oid = {Tab, 4}, 266 267 %% Start two transactions 268 {success, [B, A]} = ?start_activities(lists:duplicate(2, Node1)), 269 mnesia_test_lib:start_transactions([B, A], 0), % A is newest 270 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 271 ?match([], mnesia:system_info(held_locks)), 272 ?match([], mnesia:system_info(lock_queue)), 273 274 B ! fun() -> mnesia:write(Rec) end, 275 ?match_receive({B, ok}), 276 A ! fun() -> mnesia:read(Oid) end, 277 ?match_receive({A, {aborted, nomore}}), 278 B ! end_trans, 279 ?match_receive({B, {atomic, end_trans}}), 280 281 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 282 ?match([], mnesia:system_info(held_locks)), 283 ?match([], mnesia:system_info(lock_queue)), 284 ok. 285 286%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 287advanced_deadlock_conflict(suite) -> []; 288advanced_deadlock_conflict(Config) when is_list(Config) -> 289 [Node1, Node2] = ?acquire_nodes(2, Config), 290 Tab = advanced_deadlock_conflict, 291 create_conflict_table(Tab, [Node2]), 292 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 293 Rec = {Tab, 4, 4}, 294 Oid = {Tab, 4}, 295 296 %% Start two transactions 297 {success, [B, A]} = ?start_activities([Node1, Node2]), 298 mnesia_test_lib:start_sync_transactions([B, A], 0), % A is newest 299 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 300 ?match([], mnesia:system_info(held_locks)), 301 ?match([], mnesia:system_info(lock_queue)), 302 303 B ! fun() -> mnesia:write(Rec) end, 304 ?match_receive({B, ok}), 305 A ! fun() -> mnesia:read(Oid) end, 306 ?match_receive({A, {aborted, nomore}}), 307 B ! end_trans, 308 ?match_receive({B, {atomic, end_trans}}), 309 310 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 311 ?match([], mnesia:system_info(held_locks)), 312 ?match([], mnesia:system_info(lock_queue)), 313 ok. 314 315%% Verify (and regression test) deadlock in del_table_copy(schema, Node) 316schema_deadlock(Config) when is_list(Config) -> 317 Ns = [Node1, Node2] = ?acquire_nodes(2, Config), 318 ?match({atomic, ok}, mnesia:create_table(a, [{disc_copies, Ns}])), 319 ?match({atomic, ok}, mnesia:create_table(b, [{disc_copies, Ns}])), 320 321 Tester = self(), 322 323 Deadlocker = fun() -> 324 mnesia:write({a,1,1}), %% grab write lock on A 325 receive 326 continue -> 327 mnesia:write({b,1,1}), %% grab write lock on B 328 end_trans 329 end 330 end, 331 332 ?match(stopped, rpc:call(Node2, mnesia, stop, [])), 333 timer:sleep(500), %% Let Node1 reconfigure 334 sys:get_status(mnesia_monitor), 335 336 DoingTrans = spawn_link(fun() -> Tester ! {self(),mnesia:transaction(Deadlocker)} end), 337 wait_for_lock(DoingTrans, [Node1], 10, held), 338 %% Will grab write locks on schema, a, and b 339 DoingSchema = spawn_link(fun() -> Tester ! {self(), mnesia:del_table_copy(schema, Node2)} end), 340 timer:sleep(500), %% Let schema trans start, and try to grab locks 341 DoingTrans ! continue, 342 343 ?match(ok, receive {DoingTrans, {atomic, end_trans}} -> ok after 5000 -> timeout end), 344 ?match(ok, receive {DoingSchema, {atomic, ok}} -> ok after 5000 -> timeout end), 345 346 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 347 ?match([], mnesia:system_info(held_locks)), 348 ?match([], mnesia:system_info(lock_queue)), 349 ok. 350 351 352one_oid(Tab) -> {Tab, 1}. 353other_oid(Tab) -> {Tab, 2}. 354 355create_conflict_table(Tab, Nodes) -> 356 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 357 {ram_copies, Nodes}, 358 {attributes, [key, val]}, 359 {index, [val]} 360 ])), 361 ?match([], mnesia_test_lib:sync_tables(Nodes, [Tab])), 362 init_conflict_table(Tab). 363 364init_conflict_table(Tab) -> 365 Recs = mnesia:dirty_match_object({Tab, '_', '_'}), 366 lists:foreach(fun(R) -> mnesia:dirty_delete_object(R) end, Recs), 367 Keys = [one_oid(Tab), other_oid(Tab)], 368 [mnesia:dirty_write({T, K, K}) || {T, K} <- Keys]. 369 370%% Apply Fun for each X and Y 371fun_loop(Fun, Xs, Ys) -> 372 lists:foreach(fun(X) -> lists:foreach(fun(Y) -> do_fun(Fun, X, Y) end, Ys) end, Xs). 373 374do_fun(Fun, X, Y) -> 375 Pid = spawn_link(?MODULE, do_fun, [self(), Fun, X, Y]), 376 receive 377 {done_fun, Pid} -> done_fun 378 end. 379 380do_fun(Monitor, Fun, X, Y) -> 381 ?log("{do_fun ~p~n", [[Fun, X, Y]]), 382 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 383 ?match([], mnesia:system_info(held_locks)), 384 ?match([], mnesia:system_info(lock_queue)), 385 Fun(X, Y), 386 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 387 ?match([], mnesia:system_info(held_locks)), 388 ?match([], mnesia:system_info(lock_queue)), 389 unlink(Monitor), 390 Monitor ! {done_fun, self()}, 391 exit(done_fun). 392 393%% Returns a list of fun's 394lock_funs(no_lock, one) -> 395 [ 396 fun(Oid) -> mnesia:dirty_read(Oid) end, 397 fun({Tab, Key}) -> mnesia:dirty_write({Tab, Key, Key}) end, 398 fun({Tab, Key}) -> mnesia:dirty_write({Tab, Key, Key}), 399 mnesia:dirty_update_counter({Tab, Key}, 0) end, 400 fun(Oid) -> mnesia:dirty_delete(Oid) end, 401 fun({Tab, Key}) -> mnesia:dirty_delete_object({Tab, Key, Key}) end, 402 fun({Tab, Key}) -> mnesia:dirty_match_object({Tab, Key, Key}) end, 403 fun({Tab, Key}) -> mnesia:dirty_index_match_object({Tab, Key, Key}, val) end, 404 fun({Tab, Key}) -> mnesia:dirty_index_read(Tab, Key, val) end, 405 fun({Tab, Key}) -> mnesia:dirty_index_match_object({Tab, '_', Key}, val) end 406 ]; 407lock_funs(no_lock, all) -> 408 [ 409 fun({Tab, _}) -> mnesia:dirty_match_object({Tab, '_', '_'}) end, 410 fun({Tab, _}) -> slot_iter(Tab) end, 411 fun({Tab, _}) -> key_iter(Tab) end 412 ]; 413lock_funs(shared_lock, one) -> 414 415 [ 416 fun(Oid) -> mnesia:read(Oid) end, 417 fun({Tab, Key}) -> 418 init_conflict_table(Tab), 419 mnesia:dirty_delete(other_oid(Tab)), 420 mnesia:match_object({Tab, Key, Key}) end 421 ]; 422lock_funs(shared_lock, all) -> 423 [ 424 fun({Tab, _}) -> mnesia:read_lock_table(Tab) end, 425 fun({Tab, Key}) -> mnesia:match_object({Tab, '_', Key}) end, 426 fun({Tab, _}) -> mnesia:match_object({Tab, '_', '_'}) end, 427 fun({Tab, _}) -> mnesia:all_keys(Tab) end, 428 fun({Tab, Key}) -> mnesia:index_match_object({Tab, '_', Key}, val) end, 429 fun({Tab, Key}) -> mnesia:index_read(Tab, Key, val) end 430 ]; 431lock_funs(exclusive_lock, one) -> 432 [ 433 fun(Oid) -> mnesia:wread(Oid) end, 434 fun({Tab, Key}) -> mnesia:write({Tab, Key, Key}) end, 435 fun(Oid) -> mnesia:delete(Oid) end, 436 fun({Tab, Key}) -> mnesia:delete_object({Tab, Key, Key}) end, 437 fun({Tab, Key}) -> mnesia:s_write({Tab, Key, Key}) end, 438 fun(Oid) -> mnesia:s_delete(Oid) end, 439 fun({Tab, Key}) -> mnesia:s_delete_object({Tab, Key, Key}) end 440 ]; 441lock_funs(exclusive_lock, all) -> 442 [ 443 fun({Tab, _}) -> mnesia:write_lock_table(Tab) end 444 ]; 445lock_funs(Compatibility, any_granularity) -> 446 lists:append([lock_funs(Compatibility, Granularity) || 447 Granularity <- [one, all]]); 448lock_funs(any_lock, Granularity) -> 449 lists:append([lock_funs(Compatibility, Granularity) || 450 Compatibility <- [no_lock, shared_lock, exclusive_lock]]). 451 452slot_iter(Tab) -> 453 slot_iter(Tab, mnesia:dirty_slot(Tab, 0), 1). 454slot_iter(_Tab, '$end_of_table', _) -> 455 []; 456slot_iter(Tab, Recs, Slot) -> 457 Recs ++ slot_iter(Tab, mnesia:dirty_slot(Tab, Slot), Slot+1). 458 459key_iter(Tab) -> 460 key_iter(Tab, mnesia:dirty_first(Tab)). 461key_iter(_Tab, '$end_of_table') -> 462 []; 463key_iter(Tab, Key) -> 464 [Key | key_iter(Tab, mnesia:dirty_next(Tab, Key))]. 465 466%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 467lock_burst(suite) -> []; 468lock_burst(Config) when is_list(Config) -> 469 [Node1] = ?acquire_nodes(1, Config), 470 Tab = burst, 471 ?match({atomic, ok}, mnesia:create_table(Tab, 472 [{attributes, [a, b]}, 473 {ram_copies, [Node1]}])), 474 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 475 ?match([], mnesia:system_info(held_locks)), 476 ?match([], mnesia:system_info(lock_queue)), 477 ?match(ok, burst_em(Tab, 1000)), 478 ?match([{burst,1,1000}], mnesia:dirty_read(Tab,1)), 479 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 480 ?match([], mnesia:system_info(held_locks)), 481 ?match([], mnesia:system_info(lock_queue)), 482 ok. 483 484burst_em(Tab, N) -> 485 spawn_link(?MODULE, burst_counter, [self(), Tab, N]), 486 receive 487 burst_counter_done -> ok 488 end. 489 490burst_counter(Monitor, Tab, N) when N > 0 -> 491 ?match(ok, burst_gen(Tab, N, self())), 492 Monitor ! burst_receiver(N). 493 494burst_receiver(0) -> 495 burst_counter_done; 496burst_receiver(N) -> 497 receive 498 burst_incr_done -> 499 burst_receiver(N-1) 500 end. 501 502burst_gen(_, 0, _) -> 503 ok; 504burst_gen(Tab, N, Father) when is_integer(N), N > 0 -> 505 spawn_link(?MODULE, burst_incr, [Tab, Father]), 506 burst_gen(Tab, N-1, Father). 507 508burst_incr(Tab, Father) -> 509 Fun = fun() -> 510 Val = 511 case mnesia:read({Tab, 1}) of 512 [{Tab, 1, V}] -> V; 513 [] -> 0 514 end, 515 mnesia:write({Tab, 1, Val+1}) 516 end, 517 ?match({atomic, ok}, mnesia:transaction(Fun)), 518 Father ! burst_incr_done. 519 520%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 521 522basic_sticky_functionality(suite) -> []; 523basic_sticky_functionality(Config) when is_list(Config) -> 524 [N1, N2] = Nodes = ?acquire_nodes(2, Config), 525 Tab = basic_table, 526 Storage = mnesia_test_lib:storage_type(disc_copies, Config), 527 ?match({atomic, ok}, mnesia:create_table(Tab, [{Storage, Nodes}])), 528 ?match({atomic, ok}, mnesia:create_table(sync, [{ram_copies, Nodes}])), 529 Trans1 = fun() -> 530 ?match(ok, mnesia:s_write({Tab, 1, 2})), 531 ?match([{Tab, 1, 2}], mnesia:read({Tab, 1})), 532 ?match(timeout, receive M -> M after 500 -> timeout end), 533 ?match(ok, mnesia:s_write({Tab, 2, 2})), 534 ?match(ok, mnesia:write({Tab, 42, 4711})) 535 end, 536 Trans2 = fun() -> 537 ?match([{Tab, 1, 2}], mnesia:read({Tab, 1})), 538 ?match(timeout, receive M -> M after 500 -> timeout end), 539 ?match(ok, mnesia:write({Tab, 1, 4711})), 540 ?match(ok, mnesia:s_write({Tab, 2, 4})), 541 ?match(ok, mnesia:delete({Tab, 42})) 542 end, 543 rpc:call(N1, mnesia, transaction, [Trans1]), 544 ?match([{Tab,N1}], rpc:call(N1, ?MODULE, get_sticky, [])), 545 ?match([{Tab,N1}], rpc:call(N2, ?MODULE, get_sticky, [])), 546 547 rpc:call(N2, mnesia, transaction, [Trans2]), 548 ?match([], rpc:call(N1, ?MODULE, get_sticky, [])), 549 ?match([], rpc:call(N2, ?MODULE, get_sticky, [])), 550 551 Slock = fun() -> mnesia:read({sync,sync}),get_sticky() end, 552 ?match({atomic, [{Tab,1, 4711}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 1}) end)), 553 ?match({atomic, [{Tab,2, 4}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 2}) end)), 554 ?match({atomic, [{Tab,N1}]}, rpc:call(N1, mnesia, transaction, 555 [fun() -> mnesia:s_write({Tab, 1, 3}),Slock() end])), 556 ?match([{Tab,N1}], rpc:call(N2, ?MODULE, get_sticky, [])), 557 558 ?match({atomic,[]}, rpc:call(N2, mnesia, transaction, 559 [fun() -> mnesia:s_write({Tab, 1, 4}),Slock() end])), 560 561 ?match([], rpc:call(N1, ?MODULE, get_sticky, [])), 562 ?match([], rpc:call(N2, ?MODULE, get_sticky, [])), 563 564 ?match({atomic,[{Tab,N2}]}, rpc:call(N2, mnesia, transaction, 565 [fun() -> mnesia:s_write({Tab, 1, 4}),Slock() end])), 566 567 ?match({atomic,[]}, rpc:call(N1, mnesia, transaction, 568 [fun() -> mnesia:s_write({Tab, 1, 5}),Slock() end])), 569 ?match({atomic,[{Tab,N1}]}, rpc:call(N1, mnesia, transaction, 570 [fun() -> mnesia:s_write({Tab, 1, 5}),Slock() end])), 571 ?match({atomic,[]}, rpc:call(N2, mnesia, transaction, 572 [fun() -> mnesia:s_write({Tab, 1, 6}),Slock() end])), 573 ?match({atomic,[{Tab,N2}]}, rpc:call(N2, mnesia, transaction, 574 [fun() -> mnesia:s_write({Tab, 1, 7}),Slock() end])), 575 576 ?match([{Tab,N2}], get_sticky()), 577 ?match({atomic, [{Tab,1, 7}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 1}) end)), 578 ?match([{Tab,N2}], get_sticky()), 579 ?match({atomic, [{Tab,2, 4}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 2}) end)), 580 ?match([{Tab,N2}], get_sticky()), 581 ?match({atomic,[{Tab,N2}]}, rpc:call(N2, mnesia, transaction, 582 [fun() -> mnesia:s_write({Tab, 1, 6}),Slock() end])), 583 ?match([{Tab,N2}], get_sticky()), 584 ?match({atomic, [{Tab,1, 6}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 1}) end)), 585 ?match([{Tab,N2}], get_sticky()), 586 ?match({atomic, [{Tab,2, 4}]}, mnesia:transaction(fun() -> mnesia:read({Tab, 2}) end)), 587 ?match([{Tab,N2}], get_sticky()), 588 ?verify_mnesia(Nodes, []). 589 590get_sticky() -> 591 mnesia_locker ! {get_table, self(), mnesia_sticky_locks}, 592 receive {mnesia_sticky_locks, Locks} -> Locks end. 593 594get_held() -> 595 mnesia_locker ! {get_table, self(), mnesia_sticky_locks}, 596 receive {mnesia_sticky_locks, Locks} -> Locks end. 597 598sticky_sync(suite) -> []; 599sticky_sync(Config) when is_list(Config) -> 600 %% BUG ERIERL-768 601 Nodes = [N1, N2] = ?acquire_nodes(2, Config), 602 603 mnesia:create_table(dc, [{type, ordered_set}, {disc_copies, Nodes}]), 604 mnesia:create_table(ec, [{type, ordered_set}, {ram_copies, [N2]}]), 605 606 TestFun = 607 fun(I) -> 608 %% In first transaction we initialise {dc, I} record with value 0 609 First = fun() -> 610 %% Do a lot of writes into ram copies table 611 %% which on the Slave in do_commit will be 612 %% processed first 613 lists:foreach(fun(J) -> ok = mnesia:write(ec, {ec, J, 0}, write) end, 614 lists:seq(1, 750)), 615 %% Then set initial value of {dc, I} record to 0 with sticky_write 616 mnesia:write(dc, {dc, I, 0}, sticky_write) 617 end, 618 ok = mnesia:activity(transaction, First), 619 %% In second transaction we set value of {dc, I} record to 1 620 Upd = fun() -> 621 %% Modify a single ram copies record with ensured lock grant 622 %% (key not used in previous transactions) 623 %% we use this second table only to force asym_trans protocol 624 mnesia:write(ec, {ec, 1001 + I, 0}, write), 625 %% And set final version of {dc, I} record to 1 with sticky_write 626 mnesia:write(dc, {dc, I, 1}, sticky_write) 627 end, 628 ok = mnesia:activity(transaction, Upd) 629 end, 630 631 %% Fill 1000 dc records. At the end all dc records should have value 1. 632 {Time, ok} = timer:tc(fun() -> lists:foreach(TestFun, lists:seq(1,200)) end), 633 io:format("200 trans done in ~p ~n",[Time div (1000000)]), 634 case (Time div (1000000)) < 20 of 635 false -> lists:foreach(TestFun, lists:seq(201,1000)); 636 true -> ignore %% Some virtual test machines are really slow.. 637 end, 638 io:format("Written, check content~n",[]), 639 All = fun() -> mnesia:select(dc, [ {{dc, '_', 0}, [] ,['$_']} ]) end, 640 ?match({atomic, []}, rpc:call(N1, mnesia, sync_transaction, [All])), 641 ?match({atomic, []}, rpc:call(N2, mnesia, sync_transaction, [All])), 642 643 ?verify_mnesia(Nodes, []). 644 645%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 646 647unbound1(suite) -> []; 648unbound1(Config) when is_list(Config) -> 649 [Node1] = ?acquire_nodes(1, Config), 650 651 ?match({atomic, ok}, mnesia:create_table(ul, [])), 652 653 Tester = self(), 654 Write = fun() -> 655 mnesia:write({ul, {key, {17,42}}, val}), 656 ?log("~p Got write lock waiting...~n", [self()]), 657 Tester ! continue, 658 receive 659 continue -> 660 ok 661 end, 662 ?log("..continuing~n", []), 663 ok 664 end, 665 666 {success, [A]} = ?start_activities([Node1]), 667 ?start_transactions([A]), 668 A ! Write, 669 670 receive continue -> ok end, 671 672 Match = fun() -> 673 case catch mnesia:match_object({ul, {key, {'_', '$0'}}, '_'}) of 674 {'EXIT', What} -> %% Cyclic first time 675 ?log("Cyclic Restarting~n", []), 676 A ! continue, 677 A ! end_trans, 678 exit(What); 679 Res -> 680 ?log("Got match log ~p...~n", [Res]), 681 Res 682 end 683 end, 684 ?match({atomic, [{ul,{key,{17,42}},val}]}, mnesia:transaction(Match)), 685 686 ?match_receive({A, ok}), 687 ?match_receive({A, {atomic, end_trans}}), 688 ok. 689 690unbound2(suite) -> []; 691unbound2(Config) when is_list(Config) -> 692 [Node1] = ?acquire_nodes(1, Config), 693 694 ?match({atomic, ok}, mnesia:create_table(ul, [])), 695 696 {success, [B, A]} = ?start_activities([Node1, Node1]), 697 698 Me = self(), 699 700 Write = fun() -> 701 mnesia:write({ul, {key, {17,42}}, val}), 702 ?log("~p Got write lock waiting... Tid ~p ~n", 703 [self(), get(mnesia_activity_state)]), 704 Me ! ok_lock, 705 receive 706 continue -> 707 ok 708 end, 709 ?log("..continuing~n", []), 710 ok 711 end, 712 713 Match = fun() -> 714 receive 715 continueB -> 716 ?log("~p, moving on TID ~p~n", 717 [self(), get(mnesia_activity_state)]), 718 Me ! {self(), continuing} 719 end, 720 case catch mnesia:match_object({ul, {key, {'_', '$0'}}, 721 '_'}) of 722 {'EXIT', What} -> %% Cyclic first time 723 ?log("Cyclic Restarting ~p ~n", [What]), 724 {should_not_happen,What}; 725 Res -> 726 ?log("Got match log ~p...~n", [Res]), 727 Res 728 end 729 end, 730 731 B ! fun() -> mnesia:transaction(Match) end, 732 timer:sleep(100), %% Let B be started first.. 733 A ! fun() -> mnesia:transaction(Write) end, 734 735 receive ok_lock -> ok end, 736 737 B ! continueB, 738 ?match_receive({B, continuing}), 739 740 %% B should now be in lock queue. 741 A ! continue, 742 ?match_multi_receive([{A, {atomic, ok}}, 743 {B, {atomic, [{ul,{key,{17,42}},val}]}}]), 744 ok. 745 746 747%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 748 749create_table(suite) -> []; 750create_table(Config) when is_list(Config) -> 751 [ThisNode, Node2] = ?acquire_nodes(2, Config), 752 Tab = c_t_tab, 753 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 754 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 755 insert(Tab, 50), 756 {success, [A]} = ?start_activities([ThisNode]), 757 mnesia_test_lib:start_sync_transactions([A], 0), 758 759 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 760 ?match_receive({A, ok}), %% A is executed 761 762 DiskMaybe = mnesia_test_lib:storage_type(disc_copies, Config), 763 764 Pid = spawn_link(?MODULE, op, [self(), mnesia, create_table, 765 [test_tab1, [{DiskMaybe, [ThisNode]}]]]), 766 ?match_multi_receive([{Pid, {atomic, ok}}, 767 {'EXIT', Pid, normal}]), %% No Locks! op should be exec. 768 769 Pid2 = spawn_link(?MODULE, op, [self(), mnesia, create_table, 770 [test_tab2, [{ram_copies, [Node2]}]]]), 771 772 ?match_multi_receive([{Pid2, {atomic, ok}}, 773 {'EXIT', Pid2, normal}]), %% No Locks! op should be exec. 774 775 A ! end_trans, 776 ?match_receive({A,{atomic,end_trans}}), 777 778 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 779 ?match([], mnesia:system_info(held_locks)), 780 ?match([], mnesia:system_info(lock_queue)), 781 ok. 782 783delete_table(suite) -> []; 784delete_table(Config) when is_list(Config) -> 785 [ThisNode, Node2] = ?acquire_nodes(2, Config), 786 Tab = d_t_tab, 787 Def = [{ram_copies, [ThisNode, Node2]}, {attributes, [key, attr1, attr2]}], 788 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 789 insert(Tab, 50), 790 {success, [A]} = ?start_activities([ThisNode]), 791 mnesia_test_lib:start_sync_transactions([A], 0), 792 793 A ! fun() -> mnesia:read({Tab, 1}) end, 794 ?match_receive({A, [{Tab, 1, 1, 0}]}), %% A is executed 795 796 Pid = spawn_link(?MODULE, op, [self(), mnesia, delete_table, 797 [Tab]]), 798 799 ?match_receive(timeout), %% op waits for locks occupied by A 800 801 A ! end_trans, %% Kill A, locks should be released 802 ?match_receive({A,{atomic,end_trans}}), 803 804 receive 805 Msg -> ?match({Pid, {atomic, ok}}, Msg) 806 after 807 timer:seconds(20) -> ?error("Operation timed out", []) 808 end, 809 810 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 811 ?match([], mnesia:system_info(held_locks)), 812 ?match([], mnesia:system_info(lock_queue)), 813 ok. 814 815move_table_copy(suite) -> []; 816move_table_copy(Config) when is_list(Config) -> 817 [ThisNode, Node2] = ?acquire_nodes(2, Config), 818 Tab = m_t_c_tab, 819 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 820 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 821 insert(Tab, 50), 822 {success, [A]} = ?start_activities([ThisNode]), 823 mnesia_test_lib:start_sync_transactions([A], 0), 824 825 A ! fun() -> mnesia:write({Tab, 1, 2, 3}) end, 826 ?match_receive({A, ok}), %% A is executed 827 828 Pid = spawn_link(?MODULE, op, [self(), mnesia, move_table_copy, 829 [Tab, ThisNode, Node2]]), 830 831 ?match_receive(timeout), %% op waits for locks occupied by A 832 833 A ! end_trans, %% Kill A, locks should be released 834 ?match_receive({A,{atomic,end_trans}}), 835 836 receive 837 Msg -> ?match({Pid, {atomic, ok}}, Msg) 838 after 839 timer:seconds(20) -> ?error("Operation timed out", []) 840 end, 841 842 timer:sleep(500), %% Don't know how to sync this !!! 843 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 844 sys:get_status(whereis(mnesia_tm)), % Explicit sync, release locks is async 845 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 846 ?match([], mnesia:system_info(held_locks)), 847 ?match([], mnesia:system_info(lock_queue)), 848 ok. 849 850add_table_index(suite) -> []; 851add_table_index(Config) when is_list(Config) -> 852 [ThisNode, _Node2] = ?acquire_nodes(2, Config ++ [{tc_timeout, 60000}]), 853 Tab = a_t_i_tab, 854 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 855 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 856 insert(Tab, 50), 857 {success, [A]} = ?start_activities([ThisNode]), 858 mnesia_test_lib:start_sync_transactions([A], 0), 859 860 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 861 ?match_receive({A, ok}), %% A is executed 862 863 Pid = spawn_link(?MODULE, op, [self(), mnesia, 864 add_table_index, [Tab, attr1]]), 865 866 ?match_receive(timeout), %% op waits for locks occupied by A 867 868 A ! end_trans, %% Kill A, locks should be released 869 ?match_receive({A,{atomic,end_trans}}), 870 871 receive 872 Msg -> ?match({Pid, {atomic, ok}}, Msg) 873 after 874 timer:seconds(20) -> ?error("Operation timed out", []) 875 end, 876 877 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 878 ?match([], mnesia:system_info(held_locks)), 879 ?match([], mnesia:system_info(lock_queue)), 880 ok. 881 882del_table_index(suite) -> []; 883del_table_index(Config) when is_list(Config) -> 884 [ThisNode, _Node2] = ?acquire_nodes(2, Config), 885 Tab = d_t_i_tab, 886 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 887 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 888 insert(Tab, 50), 889 ?match({atomic, ok}, mnesia:add_table_index(Tab, attr1)), 890 891 {success, [A]} = ?start_activities([ThisNode]), 892 mnesia_test_lib:start_sync_transactions([A], 0), 893 894 A ! fun() -> mnesia:write({Tab, 51, 51, attr2}) end, 895 ?match_receive({A, ok}), %% A is executed 896 897 Pid = spawn_link(?MODULE, op, [self(), mnesia, del_table_index, 898 [Tab, attr1]]), 899 900 ?match_receive(timeout), %% op waits for locks occupied by A 901 902 A ! end_trans, %% Kill A, locks should be released 903 ?match_receive({A,{atomic,end_trans}}), 904 %% Locks released! op should be exec. 905 receive 906 Msg -> ?match({Pid, {atomic, ok}}, Msg) 907 after 908 timer:seconds(20) -> ?error("Operation timed out", []) 909 end, 910 911 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 912 ?match([], mnesia:system_info(held_locks)), 913 ?match([], mnesia:system_info(lock_queue)), 914 ok. 915 916transform_table(suite) -> []; 917transform_table(Config) when is_list(Config) -> 918 [ThisNode, Node2] = ?acquire_nodes(2, Config), 919 Tab = t_t_tab, 920 Def = [{ram_copies, [ThisNode, Node2]}, {attributes, [key, attr1, attr2]}], 921 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 922 insert(Tab, 50), 923 {success, [A]} = ?start_activities([ThisNode]), 924 mnesia_test_lib:start_sync_transactions([A], 0), 925 926 A ! fun() -> mnesia:read({Tab, 1}) end, 927 ?match_receive({A, [{Tab, 1, 1, 0}]}), %% A is executed 928 929 Transform = fun({Table, Key, Attr1, Attr2}) -> % Need todo a transform 930 {Table, Key, {Attr1, Attr2}} end, 931 Pid = spawn_link(?MODULE, op, [self(), mnesia, transform_table, 932 [Tab, Transform, [key, attr1]]]), 933 ?match_receive(timeout), %% op waits for locks occupied by A 934 935 A ! end_trans, %% Kill A, locks should be released 936 ?match_receive({A,{atomic,end_trans}}), 937 938 receive 939 Msg -> ?match({Pid, {atomic, ok}}, Msg) 940 after 941 timer:seconds(20) -> ?error("Operation timed out", []) 942 end, 943 944 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 945 ?match([], mnesia:system_info(held_locks)), 946 ?match([], mnesia:system_info(lock_queue)), 947 ok. 948 949snmp_open_table(suite) -> []; 950snmp_open_table(Config) when is_list(Config) -> 951 [ThisNode, _Node2] = ?acquire_nodes(2, Config), 952 Tab = s_o_t_tab, 953 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 954 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 955 insert(Tab, 50), 956 {success, [A]} = ?start_activities([ThisNode]), 957 mnesia_test_lib:start_sync_transactions([A], 0), 958 959 A ! fun() -> mnesia:write({Tab, 1, 1, 100}) end, 960 ?match_receive({A, ok}), %% A is executed 961 962 Pid = spawn_link(?MODULE, op, [self(), mnesia, snmp_open_table, 963 [Tab, [{key, integer}]]]), 964 965 ?match_receive(timeout), %% op waits for locks occupied by A 966 967 A ! end_trans, %% Kill A, locks should be released 968 ?match_receive({A,{atomic,end_trans}}), 969 970 %% Locks released! op should be exec. Can take a while (thats the timeout) 971 receive 972 Msg -> ?match({Pid, {atomic, ok}}, Msg) 973 after 974 timer:seconds(20) -> ?error("Operation timed out", []) 975 end, 976 977 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 978 ?match([], mnesia:system_info(held_locks)), 979 ?match([], mnesia:system_info(lock_queue)), 980 ok. 981 982snmp_close_table(suite) -> []; 983snmp_close_table(Config) when is_list(Config) -> 984 [ThisNode, _Node2] = ?acquire_nodes(2, Config), 985 Tab = s_c_t_tab, 986 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 987 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 988 ?match({atomic, ok}, mnesia:snmp_open_table(Tab, [{key, integer}])), 989 insert(Tab, 50), 990 {success, [A]} = ?start_activities([ThisNode]), 991 mnesia_test_lib:start_sync_transactions([A], 0), 992 993 A ! fun() -> mnesia:write({Tab, 1, 1, 100}) end, 994 ?match_receive({A, ok}), %% A is executed 995 996 Pid = spawn_link(?MODULE, op, [self(), mnesia, snmp_close_table, [Tab]]), 997 ?match_receive(timeout), %% op waits for locks occupied by A 998 999 A ! end_trans, %% Kill A, locks should be released 1000 ?match_receive({A,{atomic,end_trans}}), 1001 1002 %% Locks released! op should be exec. Can take a while (thats the timeout) 1003 receive 1004 Msg -> ?match({Pid, {atomic, ok}}, Msg) 1005 after 1006 timer:seconds(20) -> ?error("Operation timed out", []) 1007 end, 1008 1009 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1010 ?match([], mnesia:system_info(held_locks)), 1011 ?match([], mnesia:system_info(lock_queue)), 1012 ok. 1013 1014change_table_copy_type(suite) -> []; 1015change_table_copy_type(Config) when is_list(Config) -> 1016 [ThisNode, _Node2] = ?acquire_nodes(2, Config), 1017 Tab = c_t_c_t_tab, 1018 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 1019 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1020 insert(Tab, 50), 1021 {success, [A]} = ?start_activities([ThisNode]), 1022 mnesia_test_lib:start_sync_transactions([A], 0), 1023 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 1024 ?match_receive({A, ok}), %% A is executed 1025 1026 Pid = spawn_link(?MODULE, op, [self(), mnesia, change_table_copy_type, 1027 [Tab, ThisNode, disc_copies]]), 1028 1029 ?match_receive(timeout), %% op waits for locks occupied by A 1030 1031 A ! end_trans, %% Kill A, locks should be released 1032 ?match_receive({A,{atomic,end_trans}}), 1033 1034 receive 1035 Msg -> ?match({Pid, {atomic, ok}}, Msg) 1036 after 1037 timer:seconds(20) -> ?error("Operation timed out", []) 1038 end, 1039 1040 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1041 ?match([], mnesia:system_info(held_locks)), 1042 ?match([], mnesia:system_info(lock_queue)), 1043 ok. 1044 1045change_table_access(suite) -> []; 1046change_table_access(Config) when is_list(Config) -> 1047 [ThisNode, _Node2] = ?acquire_nodes(2, Config), 1048 Tab = c_t_a_tab, 1049 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 1050 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1051 insert(Tab, 50), 1052 {success, [A]} = ?start_activities([ThisNode]), 1053 mnesia_test_lib:start_sync_transactions([A], 0), 1054 1055 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 1056 ?match_receive({A, ok}), %% A is executed 1057 1058 Pid = spawn_link(?MODULE, op, [self(), mnesia, change_table_access_mode, 1059 [Tab, read_only]]), 1060 1061 1062 ?match_receive(timeout), %% op waits for locks occupied by A 1063 1064 A ! end_trans, %% Kill A, locks should be released 1065 ?match_receive({A,{atomic,end_trans}}), 1066 1067 receive 1068 Msg -> ?match({Pid, {atomic, ok}}, Msg) 1069 after 1070 timer:seconds(20) -> ?error("Operation timed out", []) 1071 end, 1072 1073 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1074 ?match([], mnesia:system_info(held_locks)), 1075 ?match([], mnesia:system_info(lock_queue)), 1076 ok. 1077 1078add_table_copy(suite) -> []; 1079add_table_copy(Config) when is_list(Config) -> 1080 [ThisNode, Node2] = ?acquire_nodes(2, Config), 1081 Tab = a_t_c_tab, 1082 Def = [{ram_copies, [ThisNode]}, {attributes, [key, attr1, attr2]}], 1083 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1084 insert(Tab, 50), 1085 {success, [A]} = ?start_activities([ThisNode]), 1086 mnesia_test_lib:start_sync_transactions([A], 0), 1087 1088 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 1089 ?match_receive({A, ok}), %% A is executed 1090 1091 Pid = spawn_link(?MODULE, op, [self(), mnesia, add_table_copy, 1092 [Tab, Node2, ram_copies]]), 1093 1094 ?match_receive(timeout), %% op waits for locks occupied by A 1095 1096 A ! end_trans, %% Kill A, locks should be released 1097 ?match_receive({A,{atomic,end_trans}}), 1098 1099 receive 1100 Msg -> ?match({Pid, {atomic, ok}}, Msg) 1101 after 1102 timer:seconds(20) -> ?error("Operation timed out", []) 1103 end, 1104 ?match_receive({'EXIT', Pid, normal}), 1105 1106 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1107 ?match([], mnesia:system_info(held_locks)), 1108 ?match([], mnesia:system_info(lock_queue)), 1109 1110 {atomic, ok} = mnesia:del_table_copy(Tab, Node2), 1111 Self = self(), 1112 New = spawn_link(Node2, 1113 fun () -> 1114 application:stop(mnesia), 1115 Self ! {self(), ok}, 1116 io:format(user, "restart mnesia~n", []), 1117 Self ! {self(), catch application:start(mnesia)} 1118 end), 1119 receive {New,ok} -> ok end, 1120 1121 Add = fun Add() -> 1122 case mnesia:add_table_copy(Tab, Node2, disc_copies) of 1123 {atomic, ok} -> ok; 1124 _R -> io:format(user, "aborted with reason ~p~n", [_R]), 1125 timer:sleep(10), 1126 Add() 1127 end 1128 end, 1129 1130 ?match(ok, Add()), 1131 ?match_receive({New,ok}), 1132 1133 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1134 ?match([], mnesia:system_info(held_locks)), 1135 ?match([], mnesia:system_info(lock_queue)), 1136 ok. 1137 1138del_table_copy(suite) -> []; 1139del_table_copy(Config) when is_list(Config) -> 1140 [ThisNode, Node2] = ?acquire_nodes(2, Config), 1141 Tab = d_t_c_tab, 1142 Def = [{ram_copies, [ThisNode, Node2]}, {attributes, [key, attr1, attr2]}], 1143 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1144 insert(Tab, 50), 1145 {success, [A]} = ?start_activities([ThisNode]), 1146 mnesia_test_lib:start_sync_transactions([A], 0), 1147 A ! fun() -> mnesia:write({Tab, 1, 2, 5}) end, 1148 ?match_receive({A, ok}), %% A is executed 1149 1150 Pid = spawn_link(?MODULE, op, [self(), mnesia, del_table_copy, 1151 [Tab, ThisNode]]), 1152 1153 ?match_receive(timeout), %% op waits for locks occupied by A 1154 A ! end_trans, %% Kill A, locks should be released 1155 ?match_receive({A, {atomic,end_trans}}), 1156 1157 ?match_receive({Pid, {atomic, ok}}), 1158 ?match_receive({'EXIT', Pid, normal}), 1159 1160 timer:sleep(500), %% Don't know how to sync this !!! 1161 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1162 sys:get_status(whereis(mnesia_tm)), % Explicit sync, release locks is async 1163 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1164 ?match([], mnesia:system_info(held_locks)), 1165 ?match([], mnesia:system_info(lock_queue)), 1166 ok. 1167 1168dump_tables(suite) -> []; 1169dump_tables(Config) when is_list(Config) -> 1170 [ThisNode, Node2] = ?acquire_nodes(2, Config), 1171 Tab = dump_t_tab, 1172 Def = [{ram_copies, [ThisNode, Node2]}, {attributes, [key, attr1, attr2]}], 1173 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1174 insert(Tab, 50), 1175 {success, [A]} = ?start_activities([ThisNode]), 1176 mnesia_test_lib:start_sync_transactions([A], 0), 1177 A ! fun() -> mnesia:write({Tab, 1, 1, updated}) end, 1178 ?match_receive({A, ok}), %% A is executed 1179 1180 Pid = spawn_link(?MODULE, op, [self(), mnesia, dump_tables, 1181 [[Tab]]]), 1182 1183 ?match_receive(timeout), %% op waits for locks occupied by A 1184 1185 A ! end_trans, %% Kill A, locks should be released 1186 ?match_receive({A,{atomic,end_trans}}), 1187 1188 receive 1189 Msg -> ?match({Pid, {atomic, ok}}, Msg) 1190 after 1191 timer:seconds(20) -> ?error("Operation timed out", []) 1192 end, 1193 1194 sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async 1195 ?match([], mnesia:system_info(held_locks)), 1196 ?match([], mnesia:system_info(lock_queue)), 1197 ok. 1198 1199op(Father, Mod, Fun, Args) -> 1200 Res = apply(Mod, Fun, Args), 1201 Father ! {self(), Res}. 1202 1203insert(_Tab, 0) -> ok; 1204insert(Tab, N) when N > 0 -> 1205 ok = mnesia:sync_dirty(fun() -> mnesia:write({Tab, N, N, 0}) end), 1206 insert(Tab, N-1). 1207 1208 1209update_own(Tab, Key, Acc) -> 1210 Update = 1211 fun() -> 1212 Res = mnesia:read({Tab, Key}), 1213 case Res of 1214 [{Tab, Key, Extra, Acc}] -> 1215 mnesia:write({Tab,Key,Extra, Acc+1}); 1216 Val -> 1217 {read, Val, {acc, Acc}} 1218 end 1219 end, 1220 receive 1221 {Pid, quit} -> Pid ! {self(), Acc} 1222 after 1223 0 -> 1224 case mnesia:transaction(Update) of 1225 {atomic, ok} -> 1226 update_own(Tab, Key, Acc+1); 1227 Else -> 1228 ?error("Trans failed on ~p with ~p~n" 1229 "Info w2read ~p w2write ~p w2commit ~p storage ~p ~n", 1230 [node(), 1231 Else, 1232 mnesia:table_info(Tab, where_to_read), 1233 mnesia:table_info(Tab, where_to_write), 1234 mnesia:table_info(Tab, where_to_commit), 1235 mnesia:table_info(Tab, storage_type)]) 1236 end 1237 end. 1238 1239update_shared(Tab, Me, Acc) -> 1240 Update = 1241 fun() -> 1242 W2R = mnesia:table_info(Tab, where_to_read), 1243 Res = mnesia:read({Tab, 0}), 1244 case Res of 1245 [{Tab, Key, Extra, Val}] when element(Me, Extra) == Acc -> 1246 Extra1 = setelement(Me, Extra, Acc+1), 1247 Term = {Tab, Key, Extra1, Val+1}, 1248 ok = mnesia:write(Term), 1249% ?log("At ~p: ~p w2r ~p w2w ~p ~n", 1250% [node(), Term, 1251% mnesia:table_info(Tab, where_to_read), 1252 W2W = mnesia:table_info(Tab, where_to_write), 1253 W2C = mnesia:table_info(Tab, where_to_commit), 1254%% mnesia:table_info(Tab, storage_type) 1255% ]), 1256 {_Mod, Tid, Ts} = get(mnesia_activity_state), 1257 io:format("~p ~p~n", [Tid, ets:tab2list(element(2,Ts))]), 1258 {ok,Term,{W2R,W2W,W2C}}; 1259 Val -> 1260 Info = [{acc, Acc}, {me, Me}, 1261 {tid, element(2, mnesia:get_activity_id())}, 1262 {locks, mnesia:system_info(held_locks)}], 1263 {read, Val, Info} 1264 end 1265 end, 1266 receive 1267 {Pid, quit} -> Pid ! {self(), Acc} 1268 after 1269 0 -> 1270 case mnesia:transaction(Update) of 1271 {atomic, {ok,Term,W2}} -> 1272 io:format("~p:~p:(~p,~p) ~w@~w~n", 1273 [erlang:unique_integer([monotonic,positive]), 1274 node(),Me,Acc,Term,W2]), 1275 update_shared(Tab, Me, Acc+1); 1276 Else -> 1277 ?error("Trans failed on ~p with ~p~n" 1278 "Info w2read ~p w2write ~p w2commit ~p storage ~p ~n", 1279 [node(), 1280 Else, 1281 mnesia:table_info(Tab, where_to_read), 1282 mnesia:table_info(Tab, where_to_write), 1283 mnesia:table_info(Tab, where_to_commit), 1284 mnesia:table_info(Tab, storage_type) 1285 ]) 1286 end 1287 end. 1288 1289init_admin(Def, N1, N2, N3) -> 1290 Tab = schema_ops, 1291 ?match({atomic, ok}, mnesia:create_table(Tab, Def)), 1292 insert(Tab, 1002), 1293 1294 Pid1 = spawn_link(N1, ?MODULE, update_own, [Tab, 1, 0]), 1295 Pid2 = spawn_link(N2, ?MODULE, update_own, [Tab, 2, 0]), 1296 Pid3 = spawn_link(N3, ?MODULE, update_own, [Tab, 3, 0]), 1297 1298 ?match({atomic, ok}, 1299 mnesia:transaction(fun() -> mnesia:write({Tab, 0, {0,0,0}, 0}) end)), 1300 1301 Pid4 = spawn_link(N1, ?MODULE, update_shared, [Tab, 1, 0]), 1302 Pid5 = spawn_link(N2, ?MODULE, update_shared, [Tab, 2, 0]), 1303 Pid6 = spawn_link(N3, ?MODULE, update_shared, [Tab, 3, 0]), 1304 1305 {Pid1, Pid2, Pid3, Pid4, Pid5, Pid6}. 1306 1307verify_results({P1, P2, P3, P4, P5, P6}) -> 1308 Tab = schema_ops, N1 = node(P1), N2 = node(P2), N3 = node(P3), 1309 1310 try 1311 P1 ! {self(), quit}, 1312 R1 = receive {P1, Res1} -> Res1 after 9000 -> throw({timeout,P1}) end, 1313 P2 ! {self(), quit}, 1314 R2 = receive {P2, Res2} -> Res2 after 9000 -> throw({timeout,P2}) end, 1315 P3 ! {self(), quit}, 1316 R3 = receive {P3, Res3} -> Res3 after 9000 -> throw({timeout,P3}) end, 1317 1318 P4 ! {self(), quit}, 1319 R4 = receive {P4, Res4} -> Res4 after 9000 -> throw({timeout,P4}) end, 1320 P5 ! {self(), quit}, 1321 R5 = receive {P5, Res5} -> Res5 after 9000 -> throw({timeout,P5}) end, 1322 P6 ! {self(), quit}, 1323 R6 = receive {P6, Res6} -> Res6 after 9000 -> throw({timeout,P6}) end, 1324 1325 ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write_lock_table(Tab) end)), 1326 ?log("Should be ~p~n", [R1]), 1327 ?match([{_, _, _, R1}], rpc:call(N1, mnesia, dirty_read, [{Tab, 1}])), 1328 ?match([{_, _, _, R1}], rpc:call(N2, mnesia, dirty_read, [{Tab, 1}])), 1329 ?match([{_, _, _, R1}], rpc:call(N3, mnesia, dirty_read, [{Tab, 1}])), 1330 ?log("Should be ~p~n", [R2]), 1331 ?match([{_, _, _, R2}], rpc:call(N1, mnesia, dirty_read, [{Tab, 2}])), 1332 ?match([{_, _, _, R2}], rpc:call(N2, mnesia, dirty_read, [{Tab, 2}])), 1333 ?match([{_, _, _, R2}], rpc:call(N3, mnesia, dirty_read, [{Tab, 2}])), 1334 ?log("Should be ~p~n", [R3]), 1335 ?match([{_, _, _, R3}], rpc:call(N1, mnesia, dirty_read, [{Tab, 3}])), 1336 ?match([{_, _, _, R3}], rpc:call(N2, mnesia, dirty_read, [{Tab, 3}])), 1337 ?match([{_, _, _, R3}], rpc:call(N3, mnesia, dirty_read, [{Tab, 3}])), 1338 1339 Res = R4+R5+R6, 1340 ?log("Should be {~p+~p+~p}= ~p~n", [R4, R5, R6, Res]), 1341 ?match([{_, _, {R4,R5,R6}, Res}], rpc:call(N1, mnesia, dirty_read, [{Tab, 0}])), 1342 ?match([{_, _, {R4,R5,R6}, Res}], rpc:call(N2, mnesia, dirty_read, [{Tab, 0}])), 1343 ?match([{_, _, {R4,R5,R6}, Res}], rpc:call(N3, mnesia, dirty_read, [{Tab, 0}])) 1344 catch throw:{timeout, Pid} -> 1345 mnesia_lib:dist_coredump(), 1346 ?error("Timeout ~p ~n", [Pid]) 1347 end. 1348 1349 1350get_info(Tab) -> 1351 Info = mnesia:table_info(Tab, all), 1352 mnesia_lib:verbose("~p~n", [Info]). 1353 1354del_table_copy_1(suite) -> []; 1355del_table_copy_1(Config) when is_list(Config) -> 1356 [_Node1, Node2, _Node3] = Nodes = ?acquire_nodes(3, Config), 1357 del_table(Node2, Node2, Nodes). %Called on same Node as deleted 1358del_table_copy_2(suite) -> []; 1359del_table_copy_2(Config) when is_list(Config) -> 1360 [Node1, Node2, _Node3] = Nodes = ?acquire_nodes(3, Config), 1361 del_table(Node1, Node2, Nodes). %Called from other Node 1362del_table_copy_3(suite) -> []; 1363del_table_copy_3(Config) when is_list(Config) -> 1364 [_Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1365 del_table(Node3, Node2, Nodes). %Called from Node w.o. table 1366 1367%%% The actual test 1368del_table(CallFrom, DelNode, [Node1, Node2, Node3]) -> 1369 Def = [{ram_copies, [Node1]}, {disc_copies, [Node2]}, 1370 {attributes, [key, attr1, attr2]}], 1371 Tab = schema_ops, 1372 Pids = init_admin(Def, Node1, Node2, Node3), 1373 1374 ?log("Call from ~p delete table from ~p ~n", [CallFrom, DelNode]), 1375 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1376 1377 ?match({atomic, ok}, 1378 rpc:call(CallFrom, mnesia, del_table_copy, [Tab, DelNode])), 1379 1380 verify_results(Pids), 1381 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1382 ?verify_mnesia([Node1, Node2, Node3], []). 1383 1384add_table_copy_1(suite) -> []; 1385add_table_copy_1(Config) when is_list(Config) -> 1386 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1387 Def = [{disc_only_copies, [Node1, Node2]}, 1388 {attributes, [key, attr1, attr2]}], 1389 add_table(Node1, Node3, Nodes, Def). 1390add_table_copy_2(suite) -> []; 1391add_table_copy_2(Config) when is_list(Config) -> 1392 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1393 Def = [{disc_only_copies, [Node1, Node2]}, 1394 {attributes, [key, attr1, attr2]}], 1395 add_table(Node2, Node3, Nodes, Def). 1396add_table_copy_3(suite) -> []; 1397add_table_copy_3(Config) when is_list(Config) -> 1398 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1399 Def = [{disc_only_copies, [Node1, Node2]}, 1400 {attributes, [key, attr1, attr2]}], 1401 add_table(Node3, Node3, Nodes, Def). 1402add_table_copy_4(suite) -> []; 1403add_table_copy_4(Config) when is_list(Config) -> 1404 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1405 Def = [{disc_only_copies, [Node1]}, 1406 {attributes, [key, attr1, attr2]}], 1407 add_table(Node2, Node3, Nodes, Def). 1408%%% The actual test 1409add_table(CallFrom, AddNode, [Node1, Node2, Node3], Def) -> 1410 Pids = init_admin(Def, Node1, Node2, Node3), 1411 Tab = schema_ops, 1412 ?log("Call from ~p add table to ~p ~n", [CallFrom, AddNode]), 1413 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1414 ?match({atomic, ok}, rpc:call(CallFrom, mnesia, add_table_copy, 1415 [Tab, AddNode, ram_copies])), 1416 verify_results(Pids), 1417 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1418 ?verify_mnesia([Node1, Node2, Node3], []). 1419%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1420move_table_copy_1(suite) -> []; 1421move_table_copy_1(Config) when is_list(Config) -> 1422 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1423 Def = [{disc_copies, [Node1, Node2]}, 1424 {attributes, [key, attr1, attr2]}], 1425 move_table(Node1, Node1, Node3, Nodes, Def). 1426move_table_copy_2(suite) -> []; 1427move_table_copy_2(Config) when is_list(Config) -> 1428 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1429 Def = [{disc_copies, [Node1, Node2]}, 1430 {attributes, [key, attr1, attr2]}], 1431 move_table(Node2, Node1, Node3, Nodes, Def). 1432move_table_copy_3(suite) -> []; 1433move_table_copy_3(Config) when is_list(Config) -> 1434 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1435 Def = [{disc_copies, [Node1, Node2]}, 1436 {attributes, [key, attr1, attr2]}], 1437 move_table(Node3, Node1, Node3, Nodes, Def). 1438move_table_copy_4(suite) -> []; 1439move_table_copy_4(Config) when is_list(Config) -> 1440 [Node1, Node2, Node3] = Nodes = ?acquire_nodes(3, Config), 1441 Def = [{disc_copies, [Node1]}, 1442 {attributes, [key, attr1, attr2]}], 1443 move_table(Node2, Node1, Node3, Nodes, Def). 1444%%% The actual test 1445move_table(CallFrom, FromNode, ToNode, [Node1, Node2, Node3], Def) -> 1446 Pids = init_admin(Def, Node1, Node2, Node3), 1447 Tab = schema_ops, 1448 ?log("Call from ~p move table from ~p to ~p ~n", [CallFrom, FromNode, ToNode]), 1449 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1450 ?match({atomic, ok}, rpc:call(CallFrom, mnesia, move_table_copy, 1451 [Tab, FromNode, ToNode])), 1452 verify_results(Pids), 1453 rpc:multicall([Node1, Node2, Node3], ?MODULE, get_info, [Tab]), 1454 ?verify_mnesia([Node1, Node2, Node3], []). 1455 1456%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1457 1458%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1459dirty_updates_visible_direct(doc) -> 1460 ["One process can immediately see dirty updates of another"]; 1461dirty_updates_visible_direct(suite) -> []; 1462dirty_updates_visible_direct(Config) when is_list(Config) -> 1463 dirty_visibility(outside_trans, Config). 1464 1465dirty_reads_regardless_of_trans(doc) -> 1466 ["Dirty reads are not affected by transaction context"]; 1467dirty_reads_regardless_of_trans(suite) -> []; 1468dirty_reads_regardless_of_trans(Config) when is_list(Config) -> 1469 dirty_visibility(inside_trans, Config). 1470 1471dirty_visibility(Mode, Config) -> 1472 [Node1] = ?acquire_nodes(1, Config), 1473 Tab = list_to_atom(lists:concat([dirty_visibility, '_', Mode])), 1474 1475 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, {ram_copies, [Node1]}])), 1476 ValPos = 3, 1477 1478 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1479 1480 %% Start two processes 1481 {success, [A]} = ?start_activities([Node1]), 1482 1483 case Mode of 1484 inside_trans -> 1485 ?start_transactions([A]), 1486 A ! fun() -> 1487 mnesia:write({Tab, a, 11}), 1488 mnesia:write({Tab, b, 22}), 1489 mnesia:write({Tab, c, 1}), 1490 mnesia:write({Tab, d, 2}), 1491 mnesia:write({Tab, e, 3}), 1492 lists:sort(mnesia:all_keys(Tab)) 1493 end, 1494 ?match_receive({A, [a, b, c, d, e]}); 1495 outside_trans -> 1496 ignore 1497 end, 1498 1499 RecA = {Tab, a, 1}, 1500 PatA = {Tab, '$1', 1}, 1501 RecB = {Tab, b, 3}, 1502 PatB = {Tab, '$1', 3}, 1503 RecB2 = {Tab, b, 2}, 1504 PatB2 = {Tab, '$1', 2}, 1505 ?match([], mnesia:dirty_read({Tab, a})), 1506 ?match([], mnesia:dirty_read({Tab, b})), 1507 ?match([], mnesia:dirty_match_object(PatA)), 1508 ?match([], mnesia:dirty_match_object(PatB)), 1509 ?match([], mnesia:dirty_match_object(PatB2)), 1510 ?match([], mnesia:dirty_index_read(Tab, 1, ValPos)), 1511 ?match([], mnesia:dirty_index_read(Tab, 3, ValPos)), 1512 ?match([], mnesia:dirty_index_match_object(PatA, ValPos)), 1513 ?match([], mnesia:dirty_index_match_object(PatB, ValPos)), 1514 ?match([], mnesia:dirty_index_match_object(PatB2, ValPos)), 1515 ?match('$end_of_table', mnesia:dirty_first(Tab)), 1516 1517 %% dirty_write 1518 A ! fun() -> mnesia:dirty_write(RecA) end, 1519 ?match_receive({A, ok}), 1520 ?match([RecA], mnesia:dirty_read({Tab, a})), 1521 ?match([RecA], mnesia:dirty_match_object(PatA)), 1522 ?match(a, mnesia:dirty_first(Tab)), 1523 ?match([RecA], mnesia:dirty_index_read(Tab, 1, ValPos)), 1524 ?match([RecA], mnesia:dirty_index_match_object(PatA, ValPos)), 1525 ?match('$end_of_table', mnesia:dirty_next(Tab, a)), 1526 1527 %% dirty_create 1528 A ! fun() -> mnesia:dirty_write(RecB) end, 1529 ?match_receive({A, ok}), 1530 ?match([RecB], mnesia:dirty_read({Tab, b})), 1531 ?match([RecB], mnesia:dirty_match_object(PatB)), 1532 ?match([RecB], mnesia:dirty_index_read(Tab, 3, ValPos)), 1533 ?match([RecB], mnesia:dirty_index_match_object(PatB, ValPos)), 1534 ?match('$end_of_table', 1535 mnesia:dirty_next(Tab, mnesia:dirty_next(Tab, mnesia:dirty_first(Tab)))), 1536 1537 %% dirty_update_counter 1538 A ! fun() -> mnesia:dirty_update_counter({Tab, b}, -1) end, 1539 ?match_receive({A, _}), 1540 ?match([RecB2], mnesia:dirty_read({Tab, b})), 1541 ?match([], mnesia:dirty_match_object(PatB)), 1542 ?match([RecB2], mnesia:dirty_match_object(PatB2)), 1543 ?match([RecB2], mnesia:dirty_index_read(Tab, 2, ValPos)), 1544 ?match([], mnesia:dirty_index_match_object(PatB, ValPos)), 1545 ?match([RecB2], mnesia:dirty_index_match_object(PatB2, ValPos)), 1546 ?match('$end_of_table', 1547 mnesia:dirty_next(Tab, mnesia:dirty_next(Tab, mnesia:dirty_first(Tab)))), 1548 1549 %% dirty_delete 1550 A ! fun() -> mnesia:dirty_delete({Tab, b}) end, 1551 ?match_receive({A, ok}), 1552 ?match([], mnesia:dirty_read({Tab, b})), 1553 ?match([], mnesia:dirty_match_object(PatB2)), 1554 ?match([], mnesia:dirty_index_read(Tab, 3, ValPos)), 1555 ?match([], mnesia:dirty_index_match_object(PatB2, ValPos)), 1556 ?match(a, mnesia:dirty_first(Tab)), 1557 ?match('$end_of_table', mnesia:dirty_next(Tab, a)), 1558 1559 %% dirty_delete_object 1560 ?match([RecA], mnesia:dirty_match_object(PatA)), 1561 A ! fun() -> mnesia:dirty_delete_object(RecA) end, 1562 ?match_receive({A, ok}), 1563 ?match([], mnesia:dirty_read({Tab, a})), 1564 ?match([], mnesia:dirty_match_object(PatA)), 1565 ?match([], mnesia:dirty_index_read(Tab, 1, ValPos)), 1566 ?match([], mnesia:dirty_index_match_object(PatA, ValPos)), 1567 ?match('$end_of_table', mnesia:dirty_first(Tab)), 1568 1569 case Mode of 1570 inside_trans -> 1571 A ! end_trans, 1572 ?match_receive({A, {atomic, end_trans}}); 1573 outside_trans -> 1574 ignore 1575 end, 1576 ok. 1577 1578%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1579trans_update_invisibible_outside_trans(doc) -> 1580 ["Updates in a transaction are invisible outside the transaction"]; 1581trans_update_invisibible_outside_trans(suite) -> []; 1582trans_update_invisibible_outside_trans(Config) when is_list(Config) -> 1583 [Node1] = ?acquire_nodes(1, Config), 1584 Tab = trans_update_invisibible_outside_trans, 1585 1586 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1587 {ram_copies, [Node1]}])), 1588 ValPos = 3, 1589 RecA = {Tab, a, 1}, 1590 PatA = {Tab, '$1', 1}, 1591 RecB = {Tab, b, 3}, 1592 PatB = {Tab, '$1', 3}, 1593 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1594 1595 Verify = 1596 fun() -> 1597 ?match([], mnesia:dirty_read({Tab, a})), 1598 ?match([], mnesia:dirty_read({Tab, b})), 1599 ?match([], mnesia:dirty_match_object(PatA)), 1600 ?match([], mnesia:dirty_match_object(PatB)), 1601 ?match([], mnesia:dirty_index_read(Tab, 1, ValPos)), 1602 ?match([], mnesia:dirty_index_read(Tab, 3, ValPos)), 1603 ?match([], mnesia:dirty_index_match_object(PatA, ValPos)), 1604 ?match([], mnesia:dirty_index_match_object(PatB, ValPos)), 1605 ?match('$end_of_table', mnesia:dirty_first(Tab)) 1606 end, 1607 1608 Fun = fun() -> 1609 ?match(ok, mnesia:write(RecA)), 1610 Verify(), 1611 1612 ?match(ok, mnesia:write(RecB)), 1613 Verify(), 1614 1615 ?match(ok, mnesia:delete({Tab, b})), 1616 Verify(), 1617 1618 ?match([RecA], mnesia:match_object(PatA)), 1619 Verify(), 1620 1621 ?match(ok, mnesia:delete_object(RecA)), 1622 Verify(), 1623 ok 1624 end, 1625 ?match({atomic, ok}, mnesia:transaction(Fun)), 1626 Verify(), 1627 ok. 1628 1629%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1630trans_update_visible_inside_trans(doc) -> 1631 ["Updates in a transaction are visible in the same transaction"]; 1632trans_update_visible_inside_trans(suite) -> []; 1633trans_update_visible_inside_trans(Config) when is_list(Config) -> 1634 [Node1] = ?acquire_nodes(1, Config), 1635 Tab = trans_update_visible_inside_trans, 1636 1637 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1638 {ram_copies, [Node1]}])), 1639 ValPos = 3, 1640 RecA = {Tab, a, 1}, 1641 RecA2 = {Tab, a, 2}, 1642 PatA = {Tab, '$1', 1}, 1643 RecB = {Tab, b, 3}, 1644 PatB = {Tab, '$1', 3}, 1645 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1646 1647 Fun = fun() -> 1648 %% write 1649 ?match(ok, mnesia:write(RecA)), 1650 ?match([RecA], mnesia:read({Tab, a})), 1651 ?match([RecA], mnesia:wread({Tab, a})), 1652 ?match([RecA], mnesia:match_object(PatA)), 1653 ?match([a], mnesia:all_keys(Tab)), 1654 ?match([RecA], mnesia:index_match_object(PatA, ValPos)), 1655 ?match([RecA], mnesia:index_read(Tab, 1, ValPos)), 1656 1657 %% create 1658 ?match(ok, mnesia:write(RecB)), 1659 ?match([RecB], mnesia:read({Tab, b})), 1660 ?match([RecB], mnesia:wread({Tab, b})), 1661 ?match([RecB], mnesia:match_object(PatB)), 1662 ?match([RecB], mnesia:index_match_object(PatB, ValPos)), 1663 ?match([RecB], mnesia:index_read(Tab, 3, ValPos)), 1664 1665 %% delete 1666 ?match(ok, mnesia:delete({Tab, b})), 1667 ?match([], mnesia:read({Tab, b})), 1668 ?match([], mnesia:wread({Tab, b})), 1669 ?match([], mnesia:match_object(PatB)), 1670 ?match([a], mnesia:all_keys(Tab)), 1671 ?match([], mnesia:index_match_object(PatB, ValPos)), 1672 ?match([], mnesia:index_read(Tab, 2, ValPos)), 1673 ?match([], mnesia:index_read(Tab, 3, ValPos)), 1674 1675 %% delete_object 1676 ?match(ok, mnesia:delete_object(RecA2)), 1677 ?match([RecA], mnesia:read({Tab, a})), 1678 ?match([RecA], mnesia:wread({Tab, a})), 1679 ?match([RecA], mnesia:match_object(PatA)), 1680 ?match([a], mnesia:all_keys(Tab)), 1681 ?match([RecA], mnesia:index_match_object(PatA, ValPos)), 1682 ?match([RecA], mnesia:index_read(Tab, 1, ValPos)), 1683 1684 ?match(ok, mnesia:delete_object(RecA)), 1685 ?match([], mnesia:read({Tab, a})), 1686 ?match([], mnesia:wread({Tab, a})), 1687 ?match([], mnesia:match_object(PatA)), 1688 ?match([], mnesia:all_keys(Tab)), 1689 ?match([], mnesia:index_match_object(PatA, ValPos)), 1690 ?match([], mnesia:index_read(Tab, 2, ValPos)), 1691 ?match([], mnesia:index_read(Tab, 3, ValPos)), 1692 ok 1693 end, 1694 ?match({atomic, ok}, mnesia:transaction(Fun)), 1695 ok. 1696 1697%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1698write_shadows(doc) -> 1699 ["Tests whether the shadow shows the correct object when", 1700 "writing to the table"]; 1701write_shadows(suite) -> []; 1702write_shadows(Config) when is_list(Config) -> 1703 [Node1] = ?acquire_nodes(1, Config), 1704 Tab = write_shadows, 1705 1706 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1707 {ram_copies, [Node1]}, 1708 {type, set}])), 1709 ValPos = 3, 1710 RecA1 = {Tab, a, 1}, 1711 PatA1 = {Tab, '$1', 1}, 1712 RecA2 = {Tab, a, 2}, 1713 PatA2 = {Tab, '$1', 2}, 1714 1715 1716 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1717 1718 Fun1 = fun() -> 1719 ?match(ok, mnesia:write(RecA1)), 1720 ok 1721 end, 1722 1723 ?match({atomic, ok}, mnesia:transaction(Fun1)), 1724 1725 Fun2 = fun() -> 1726 %% write shadow old write - is the confirmed value visable 1727 %% in the shadow ? 1728 ?match([RecA1], mnesia:read({Tab, a})), 1729 ?match([RecA1], mnesia:wread({Tab, a})), 1730 ?match([RecA1], mnesia:match_object(PatA1)), 1731 ?match([a], mnesia:all_keys(Tab)), 1732 ?match([RecA1], mnesia:index_match_object(PatA1, ValPos)), 1733 ?match([RecA1], mnesia:index_read(Tab, 1, ValPos)), 1734 1735 %% write shadow new write - is a new value visable instead 1736 %% of the old value ? 1737 ?match(ok, mnesia:write(RecA2)), 1738 1739 ?match([RecA2], mnesia:read({Tab, a})), 1740 ?match([RecA2], mnesia:wread({Tab, a})), 1741 ?match([], mnesia:match_object(PatA1)), %% delete shadow old but not new write 1742 ?match([RecA2], mnesia:match_object(PatA2)), %% is the new value visable 1743 1744 ?match([a], mnesia:all_keys(Tab)), 1745 ?match([RecA2], mnesia:index_match_object(PatA2, ValPos)), 1746 ?match([RecA2], mnesia:index_read(Tab, 2, ValPos)), 1747 ok 1748 1749 end, 1750 ?match({atomic, ok}, mnesia:transaction(Fun2)), 1751 ok. 1752 1753%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1754delete_shadows(doc) -> 1755 ["Test whether the shadow shows the correct object when deleting objects"]; 1756delete_shadows(suite) -> []; 1757delete_shadows(Config) when is_list(Config) -> 1758 [Node1] = ?acquire_nodes(1, Config), 1759 Tab = delete_shadows, 1760 1761 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1762 {ram_copies, [Node1]}, 1763 {type, set}])), 1764 ValPos = 3, 1765 OidA = {Tab, a}, 1766 RecA1 = {Tab, a, 1}, 1767 PatA1 = {Tab, '$1', 1}, 1768 RecA2 = {Tab, a, 2}, 1769 PatA2 = {Tab, '$1', 2}, 1770 1771 1772 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1773 1774 Fun1 = fun() -> 1775 ?match(ok, mnesia:write(RecA1)), 1776 ok 1777 end, 1778 1779 ?match({atomic, ok}, mnesia:transaction(Fun1)), 1780 1781 Fun2 = fun() -> 1782 1783 1784 %% delete shadow old write - is the confirmed value invisible 1785 %% when deleted in the transaction ? 1786 ?match(ok, mnesia:delete(OidA)), 1787 1788 ?match([], mnesia:read({Tab, a})), 1789 ?match([], mnesia:wread({Tab, a})), 1790 ?match([], mnesia:match_object(PatA1)), 1791 ?match([], mnesia:all_keys(Tab)), 1792 ?match([], mnesia:index_match_object(PatA1, ValPos)), 1793 ?match([], mnesia:index_read(Tab, 1, ValPos)), 1794 1795 %% delete shadow old but not new write - is the new value visable 1796 %% when the old one was deleted ? 1797 ?match(ok, mnesia:write(RecA2)), 1798 1799 ?match([RecA2], mnesia:read({Tab, a})), 1800 ?match([RecA2], mnesia:wread({Tab, a})), 1801 ?match([], mnesia:match_object(PatA1)), 1802 ?match([RecA2], mnesia:match_object(PatA2)), 1803 ?match([a], mnesia:all_keys(Tab)), 1804 ?match([RecA2], mnesia:index_match_object(PatA2, ValPos)), 1805 ?match([RecA2], mnesia:index_read(Tab, 2, ValPos)), 1806 1807 %% delete shadow old and new write - is the new value invisable 1808 %% when deleted ? 1809 ?match(ok, mnesia:delete(OidA)), 1810 1811 ?match([], mnesia:read({Tab, a})), 1812 ?match([], mnesia:wread({Tab, a})), 1813 ?match([], mnesia:match_object(PatA2)), 1814 ?match([], mnesia:all_keys(Tab)), 1815 ?match([], mnesia:index_match_object(PatA2, ValPos)), 1816 ?match([], mnesia:index_read(Tab, 2, ValPos)), 1817 ok 1818 1819 end, 1820 ?match({atomic, ok}, mnesia:transaction(Fun2)), 1821 ok. 1822 1823%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1824write_delete_shadows_bag(doc) -> 1825 ["Test the visibility of written and deleted objects in an bag type table"]; 1826write_delete_shadows_bag(suite) -> []; 1827write_delete_shadows_bag(Config) when is_list(Config) -> 1828 [Node1] = ?acquire_nodes(1, Config), 1829 Tab = write_delete_shadows_bag, 1830 1831 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1832 {ram_copies, [Node1]}, 1833 {type, bag}])), 1834 ValPos = 3, 1835 OidA = {Tab, a}, 1836 1837 RecA1 = {Tab, a, 1}, 1838 PatA1 = {Tab, '$1', 1}, 1839 1840 RecA2 = {Tab, a, 2}, 1841 PatA2 = {Tab, '$1', 2}, 1842 1843 RecA3 = {Tab, a, 3}, 1844 PatA3 = {Tab, '$1', 3}, 1845 1846 PatA = {Tab, a, '_'}, 1847 1848 1849 ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), 1850 1851 Fun1 = fun() -> 1852 ?match(ok, mnesia:write(RecA1)), 1853 ?match(ok, mnesia:write(RecA2)), 1854 ok 1855 end, 1856 1857 ?match({atomic, ok}, mnesia:transaction(Fun1)), 1858 1859 Fun2 = fun() -> 1860 %% delete shadow old write - is the confirmed value invisible 1861 %% when deleted in the transaction ? 1862 ?match(ok, mnesia:delete_object(RecA1)), 1863 1864 ?match([RecA2], mnesia:read({Tab, a})), 1865 ?match([RecA2], mnesia:wread({Tab, a})), 1866 ?match([RecA2], mnesia:match_object(PatA2)), 1867 ?match([a], mnesia:all_keys(Tab)), 1868 ?match([RecA2], mnesia:index_match_object(PatA2, ValPos)), 1869 ?match([RecA2], mnesia:index_read(Tab, 2, ValPos)), 1870 1871 ?match(ok, mnesia:delete(OidA)), 1872 1873 ?match([], mnesia:read({Tab, a})), 1874 ?match([], mnesia:wread({Tab, a})), 1875 ?match([], mnesia:match_object(PatA1)), 1876 ?match([], mnesia:all_keys(Tab)), 1877 ?match([], mnesia:index_match_object(PatA1, ValPos)), 1878 ?match([], mnesia:index_read(Tab, 1, ValPos)), 1879 1880 %% delete shadow old but not new write - are both new value visable 1881 %% when the old one was deleted ? 1882 ?match(ok, mnesia:write(RecA2)), 1883 ?match(ok, mnesia:write(RecA3)), 1884 1885 1886 ?match([RecA2, RecA3], lists:sort(mnesia:read({Tab, a}))), 1887 ?match([RecA2, RecA3], lists:sort(mnesia:wread({Tab, a}))), 1888 ?match([RecA2], mnesia:match_object(PatA2)), 1889 ?match([a], mnesia:all_keys(Tab)), 1890 ?match([RecA2, RecA3], lists:sort(mnesia:match_object(PatA))), 1891 ?match([RecA2], mnesia:index_match_object(PatA2, ValPos)), 1892 ?match([RecA3], mnesia:index_match_object(PatA3, ValPos)), 1893 ?match([RecA2], mnesia:index_read(Tab, 2, ValPos)), 1894 1895 %% delete shadow old and new write - is the new value invisable 1896 %% when deleted ? 1897 ?match(ok, mnesia:delete(OidA)), 1898 1899 ?match([], mnesia:read({Tab, a})), 1900 ?match([], mnesia:wread({Tab, a})), 1901 ?match([], mnesia:match_object(PatA2)), 1902 ?match([], mnesia:all_keys(Tab)), 1903 ?match([], mnesia:index_match_object(PatA2, ValPos)), 1904 ?match([], mnesia:index_read(Tab, 2, ValPos)), 1905 ok 1906 end, 1907 ?match({atomic, ok}, mnesia:transaction(Fun2)), 1908 ok. 1909 1910write_delete_shadows_bag2(doc) -> 1911 ["Test the visibility of written and deleted objects in an bag type table " 1912 "and verifies the results"]; 1913write_delete_shadows_bag2(suite) -> []; 1914write_delete_shadows_bag2(Config) when is_list(Config) -> 1915 1916 [Node1] = ?acquire_nodes(1, Config), 1917 Tab = w_d_s_b, 1918 1919 ?match({atomic, ok}, mnesia:create_table([{name, Tab}, 1920 {ram_copies, [Node1]}, 1921 {type, bag}])), 1922 Del = fun() -> 1923 R1 = mnesia:read({Tab, 1}), 1924 mnesia:delete({Tab, 1}), 1925 R2 = mnesia:read({Tab, 1}), 1926 mnesia:write({Tab, 1, 1}), 1927 mnesia:write({Tab, 1, 2}), 1928 R3 = mnesia:read({Tab, 1}), 1929 {R1, R2, R3} 1930 end, 1931 DelObj = fun() -> 1932 R1 = mnesia:read({Tab, 2}), 1933 mnesia:delete_object({Tab, 2, 2}), 1934 R2 = mnesia:read({Tab, 2}), 1935 mnesia:write({Tab, 2, 1}), 1936 mnesia:write({Tab, 2, 2}), 1937 R3 = mnesia:read({Tab, 2}), 1938 {R1, R2, R3} 1939 end, 1940 Both1 = [{Tab, 1, 1}, {Tab, 1, 2}], 1941 Both2 = [{Tab, 2, 1}, {Tab, 2, 2}], 1942 ?match({atomic, {[], [], Both1}}, mnesia:transaction(Del)), 1943 ?match({atomic, {Both1, [], Both1}}, mnesia:transaction(Del)), 1944 ?match({atomic, Both1}, mnesia:transaction(fun() -> mnesia:read({Tab, 1}) end)), 1945 ?match({atomic, {[], [], Both2}}, mnesia:transaction(DelObj)), 1946 ?match({atomic, {Both2, [{Tab, 2, 1}], Both2}}, mnesia:transaction(DelObj)), 1947 ?match({atomic, Both2}, mnesia:transaction(fun() -> mnesia:read({Tab, 2}) end)), 1948 ?verify_mnesia([Node1], []). 1949 1950shadow_search(doc) -> 1951 ["Verifies that ordered_set tables are ordered, and the order is kept" 1952 "even when table is shadowed by transaction updates"]; 1953shadow_search(suite) -> []; 1954shadow_search(Config) when is_list(Config) -> 1955 [Node1] = ?acquire_nodes(1, Config), 1956 Tab1 = ss_oset, 1957 Tab2 = ss_set, 1958 Tab3 = ss_bag, 1959 Tabs = [Tab1,Tab2,Tab3], 1960 RecName = ss, 1961 ?match({atomic, ok}, mnesia:create_table([{name, Tab1}, 1962 {ram_copies, [Node1]}, 1963 {record_name, RecName}, 1964 {type, ordered_set}])), 1965 ?match({atomic, ok}, mnesia:create_table([{name, Tab2}, 1966 {record_name, RecName}, 1967 {ram_copies, [Node1]}, 1968 {type, set}])), 1969 ?match({atomic, ok}, mnesia:create_table([{name, Tab3}, 1970 {record_name, RecName}, 1971 {ram_copies, [Node1]}, 1972 {type, bag}])), 1973 Recs = [{RecName, K, K} || K <- [1,3,5]], 1974 [mnesia:dirty_write(Tab1, R) || R <- Recs], 1975 [mnesia:dirty_write(Tab2, R) || R <- Recs], 1976 [mnesia:dirty_write(Tab3, R) || R <- Recs], 1977 1978 Match = fun(Tab) -> mnesia:match_object(Tab, {'_','_','_'}, write) end, 1979 Select = fun(Tab) -> mnesia:select(Tab, [{'_', [], ['$_']}]) end, 1980% Trans = fun(Fun,Args) -> mnesia:transaction(Fun,Args) end, 1981 LoopHelp = fun('$end_of_table',_) -> []; 1982 ({Res,Cont},Fun) -> 1983 Sel = mnesia:select(Cont), 1984 Res ++ Fun(Sel, Fun) 1985 end, 1986 SelLoop = fun(Table) -> 1987 Sel = mnesia:select(Table, [{'_', [], ['$_']}], 1, read), 1988 LoopHelp(Sel,LoopHelp) 1989 end, 1990 1991 R1 = {RecName, 2, 2}, R2 = {RecName, 4, 4}, 1992 R3 = {RecName, 2, 3}, R4 = {RecName, 3, 1}, 1993 R5 = {RecName, 104, 104}, 1994 W1 = fun(Tab,Search) -> mnesia:write(Tab,R1,write), 1995 mnesia:write(Tab,R2,write), 1996 Search(Tab) 1997 end, 1998 S1 = lists:sort([R1,R2|Recs]), 1999 ?match({atomic,S1}, mnesia:transaction(W1, [Tab1,Select])), 2000 ?match({atomic,S1}, mnesia:transaction(W1, [Tab1,Match])), 2001 ?match({atomic,S1}, mnesia:transaction(W1, [Tab1,SelLoop])), 2002 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab2,Select]))), 2003 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab2,SelLoop]))), 2004 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab2,Match]))), 2005 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab3,Select]))), 2006 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab3,SelLoop]))), 2007 ?match({atomic,S1}, sort_res(mnesia:transaction(W1, [Tab3,Match]))), 2008 [mnesia:dirty_delete_object(Tab,R) || R <- [R1,R2], Tab <- Tabs], 2009 2010 W2 = fun(Tab,Search) -> 2011 mnesia:write(Tab,R3,write), 2012 mnesia:write(Tab,R1,write), 2013 Search(Tab) 2014 end, 2015 S2 = lists:sort([R1|Recs]), 2016 S2Bag = lists:sort([R1,R3|Recs]), 2017 ?match({atomic,S2}, mnesia:transaction(W2, [Tab1,Select])), 2018 ?match({atomic,S2}, mnesia:transaction(W2, [Tab1,SelLoop])), 2019 ?match({atomic,S2}, mnesia:transaction(W2, [Tab1,Match])), 2020 ?match({atomic,S2}, sort_res(mnesia:transaction(W2, [Tab2,Select]))), 2021 ?match({atomic,S2}, sort_res(mnesia:transaction(W2, [Tab2,SelLoop]))), 2022 ?match({atomic,S2}, sort_res(mnesia:transaction(W2, [Tab2,Match]))), 2023 ?match({atomic,S2Bag}, sort_res(mnesia:transaction(W2, [Tab3,Select]))), 2024 ?match({atomic,S2Bag}, sort_res(mnesia:transaction(W2, [Tab3,SelLoop]))), 2025 ?match({atomic,S2Bag}, sort_res(mnesia:transaction(W2, [Tab3,Match]))), 2026%% [mnesia:dirty_delete_object(Tab,R) || R <- [R1,R3], Tab <- Tabs], 2027 2028 W3 = fun(Tab,Search) -> 2029 mnesia:write(Tab,R4,write), 2030 mnesia:delete(Tab,element(2,R1),write), 2031 Search(Tab) 2032 end, 2033 S3Bag = lists:sort([R4|lists:delete(R1,Recs)]), 2034 S3 = lists:delete({RecName,3,3},S3Bag), 2035 ?match({atomic,S3}, mnesia:transaction(W3, [Tab1,Select])), 2036 ?match({atomic,S3}, mnesia:transaction(W3, [Tab1,SelLoop])), 2037 ?match({atomic,S3}, mnesia:transaction(W3, [Tab1,Match])), 2038 ?match({atomic,S3}, sort_res(mnesia:transaction(W3, [Tab2,SelLoop]))), 2039 ?match({atomic,S3}, sort_res(mnesia:transaction(W3, [Tab2,Select]))), 2040 ?match({atomic,S3}, sort_res(mnesia:transaction(W3, [Tab2,Match]))), 2041 ?match({atomic,S3Bag}, sort_res(mnesia:transaction(W3, [Tab3,Select]))), 2042 ?match({atomic,S3Bag}, sort_res(mnesia:transaction(W3, [Tab3,SelLoop]))), 2043 ?match({atomic,S3Bag}, sort_res(mnesia:transaction(W3, [Tab3,Match]))), 2044 2045 W4 = fun(Tab,Search) -> 2046 mnesia:delete(Tab,-1,write), 2047 mnesia:delete(Tab,4 ,write), 2048 mnesia:delete(Tab,17,write), 2049 mnesia:delete_object(Tab,{RecName, -1, x},write), 2050 mnesia:delete_object(Tab,{RecName, 4, x},write), 2051 mnesia:delete_object(Tab,{RecName, 42, x},write), 2052 mnesia:delete_object(Tab,R2,write), 2053 mnesia:write(Tab, R5, write), 2054 Search(Tab) 2055 end, 2056 S4Bag = lists:sort([R5|S3Bag]), 2057 S4 = lists:sort([R5|S3]), 2058 ?match({atomic,S4}, mnesia:transaction(W4, [Tab1,Select])), 2059 ?match({atomic,S4}, mnesia:transaction(W4, [Tab1,SelLoop])), 2060 ?match({atomic,S4}, mnesia:transaction(W4, [Tab1,Match])), 2061 ?match({atomic,S4}, sort_res(mnesia:transaction(W4, [Tab2,Select]))), 2062 ?match({atomic,S4}, sort_res(mnesia:transaction(W4, [Tab2,SelLoop]))), 2063 ?match({atomic,S4}, sort_res(mnesia:transaction(W4, [Tab2,Match]))), 2064 ?match({atomic,S4Bag}, sort_res(mnesia:transaction(W4, [Tab3,Select]))), 2065 ?match({atomic,S4Bag}, sort_res(mnesia:transaction(W4, [Tab3,SelLoop]))), 2066 ?match({atomic,S4Bag}, sort_res(mnesia:transaction(W4, [Tab3,Match]))), 2067 [mnesia:dirty_delete_object(Tab,R) || R <- [{RecName,3,3},R5], Tab <- Tabs], 2068 2069 %% hmmm anything more?? 2070 2071 ?verify_mnesia([Node1], []). 2072 2073 2074rr_kill_copy(suite) -> []; 2075rr_kill_copy(Config) when is_list(Config) -> 2076 Ns = ?acquire_nodes(3,Config ++ [{tc_timeout, 60000}]), 2077 DeleteMe = fun(_Tab,Where2read) -> 2078 ?match([], mnesia_test_lib:kill_mnesia([Where2read])) 2079 end, 2080 Del = removed_resources(Ns, DeleteMe), 2081 ?verify_mnesia(Ns -- [Del], []). 2082 2083removed_resources([_N1,N2,N3], DeleteRes) -> 2084 Tab = del_res, 2085 ?match({atomic, ok}, mnesia:create_table(Tab,[{ram_copies, [N2,N3]}])), 2086 2087 Init = fun() -> [mnesia:write({Tab,Key,Key}) || Key <- lists:seq(0,99)] end, 2088 ?match([], [Bad || Bad <- mnesia:sync_dirty(Init), Bad /= ok]), 2089 2090 Where2Read = mnesia:table_info(Tab, where_to_read), 2091 [Keep] = [N2,N3] -- [Where2Read], 2092 Tester = self(), 2093 2094 Conflict = fun() -> 2095 %% Read a value.. 2096 [{Tab,1,Val}] = mnesia:read({Tab,1}), 2097 case get(restart) of 2098 undefined -> 2099 Tester ! {pid_1, self()}, 2100 %% Wait for sync, the read value have been 2101 %% updated and this function should be restarted. 2102 receive {Tester,sync} -> ok end, 2103 put(restart, restarted); 2104 restarted -> 2105 ok 2106 end, 2107 mnesia:write({Tab,1,Val+10}) 2108 end, 2109 Lucky = fun() -> 2110 [{Tab,1,Val}] = mnesia:read({Tab,1}), 2111 mnesia:write({Tab,1,Val+100}) 2112 end, 2113 2114 CPid = spawn_link(fun() -> Tester ! {self(), mnesia:transaction(Conflict)} end), 2115 2116 %% sync first transaction 2117 receive {pid_1, CPid} -> synced end, 2118 2119 DeleteRes(Tab, Where2Read), 2120 2121 ?match(Keep, mnesia:table_info(Tab, where_to_read)), 2122 2123 %% Run the other/Lucky transaction, this should work since 2124 %% it won't grab a lock on the conflicting transactions Where2Read node. 2125 2126 LPid = spawn_link(Keep, fun() -> Tester ! {self(),mnesia:transaction(Lucky)} end), 2127 ?match_receive({LPid,{atomic,ok}}), 2128 2129 %% Continue Transaction no 1 2130 CPid ! {self(), sync}, 2131 2132 ?match(ok, receive {CPid,{atomic,ok}} -> ok after 2000 -> process_info(self()) end), 2133 2134 ?match({atomic,[{del_res,1,111}]}, mnesia:transaction(fun() -> mnesia:read({Tab,1}) end)), 2135 Where2Read. 2136 2137nasty(suite) -> []; 2138 2139nasty(doc) -> 2140 ["Tries to fullfill a rather nasty locking scenario, where we have had " 2141 "bugs, the testcase tries a combination of locks in locker queue"]; 2142 2143%% This testcase no longer works as it was intended to show errors when 2144%% tablelocks was allowed to be placed in the queue though locks existed 2145%% in the queue with less Tid's. This is no longer allowed and the testcase 2146%% has been update. 2147 2148nasty(Config) -> 2149 ?acquire_nodes(1, Config), 2150 Tab = nasty, 2151 ?match({atomic, ok}, mnesia:create_table(Tab, [])), 2152 Coord = self(), 2153 Write = fun(Key) -> 2154 mnesia:write({Tab, Key, write}), 2155 Coord ! {write, Key, self(), mnesia:get_activity_id()}, 2156 receive 2157 continue -> 2158 ok 2159 end, 2160 Coord ! {done, {write, Key}, self()} 2161 end, 2162 2163 Update = fun(Key) -> 2164 Coord ! {update, Key, self(), mnesia:get_activity_id()}, 2165 receive 2166 continue -> 2167 ok 2168 end, 2169 mnesia:read({Tab, Key}), 2170 mnesia:write({Tab, Key, update}), 2171 receive 2172 continue -> 2173 ok 2174 end, 2175 2176 Coord ! {done, {update, Key}, self()} 2177 end, 2178 2179 TabLock = fun() -> 2180 Coord ! {tablock, Tab, self(), mnesia:get_activity_id()}, 2181 receive 2182 continue -> 2183 ok 2184 end, 2185 mnesia:lock({table, Tab}, write), 2186 Coord ! {done, {tablock, Tab}, self()} 2187 end, 2188 2189 Up = spawn_link(mnesia, transaction, [Update, [0]]), 2190 ?match_receive({update, 0, Up, _Tid}), 2191 TL = spawn_link(mnesia, transaction, [TabLock]), 2192 ?match_receive({tablock, Tab, _Tl, _Tid}), 2193 W0 = spawn_link(mnesia, transaction, [Write, [0]]), 2194 ?match_receive({write, 0, W0, _Tid}), 2195 W1 = spawn_link(mnesia, transaction, [Write, [1]]), 2196 ?match_receive({write, 1, W1, _Tid}), 2197 2198 %% Nothing should be in msg queue! 2199 ?match(timeout, receive A -> A after 1000 -> timeout end), 2200 Up ! continue, %% Should be queued 2201 ?match(timeout, receive A -> A after 1000 -> timeout end), 2202 TL ! continue, %% Should be restarted 2203% ?match({tablock, _, _, _}, receive A -> A after 1000 -> timeout end), 2204 ?match(timeout, receive A -> A after 1000 -> timeout end), 2205 2206 LQ1 = mnesia_locker:get_lock_queue(), 2207 ?match({2, _}, {length(LQ1), LQ1}), 2208 W0 ! continue, % Up should be in queue 2209 ?match_receive({done, {write, 0}, W0}), 2210 ?match_receive({'EXIT', W0, normal}), 2211 2212 TL ! continue, % Should stay in queue W1 2213 ?match(timeout, receive A -> A after 1000 -> timeout end), 2214 Up ! continue, % Should stay in queue (TL got higher tid) 2215 ?match(timeout, receive A -> A after 1000 -> timeout end), 2216 2217 LQ2 = mnesia_locker:get_lock_queue(), 2218 ?match({2, _}, {length(LQ2), LQ2}), 2219 2220 W1 ! continue, 2221 ?match_receive({done, {write, 1}, W1}), 2222 get_exit(W1), 2223 get_exit(TL), 2224 ?match_receive({done, {tablock,Tab}, TL}), 2225 get_exit(Up), 2226 ?match_receive({done, {update, 0}, Up}), 2227 2228 ok. 2229 2230get_exit(Pid) -> 2231 receive 2232 {'EXIT', Pid, normal} -> 2233 ok 2234 after 10000 -> 2235 ?error("Timeout EXIT ~p~n", [Pid]) 2236 end. 2237 2238 2239foldl(doc) -> 2240 [""]; 2241foldl(suite) -> 2242 []; 2243foldl(Config) when is_list(Config) -> 2244 Nodes = [_,N2] = ?acquire_nodes(2, Config), 2245 Tab1 = foldl_local, 2246 Tab2 = foldl_remote, 2247 Tab3 = foldl_ordered, 2248 Tab11 = foldr_local, 2249 Tab21 = foldr_remote, 2250 Tab31 = foldr_ordered, 2251 ?match({atomic, ok}, mnesia:create_table(Tab1, [{ram_copies, Nodes}])), 2252 ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies, [N2]}, {type, bag}])), 2253 ?match({atomic, ok}, mnesia:create_table(Tab3, [{ram_copies, Nodes}, 2254 {type, ordered_set}])), 2255 ?match({atomic, ok}, mnesia:create_table(Tab11, [{ram_copies, Nodes}])), 2256 ?match({atomic, ok}, mnesia:create_table(Tab21, [{ram_copies, [N2]}, {type, bag}])), 2257 ?match({atomic, ok}, mnesia:create_table(Tab31, [{ram_copies, Nodes}, 2258 {type, ordered_set}])), 2259 2260 2261 Tab1Els = [{Tab1, N, N} || N <- lists:seq(1, 10)], 2262 Tab2Els = [{Tab2, 1, 2} | [{Tab2, N, N} || N <- lists:seq(1, 10)]], 2263 Tab3Els = [{Tab3, N, N} || N <- lists:seq(1, 10)], 2264 Tab11Els = [{Tab11, N, N} || N <- lists:seq(1, 10)], 2265 Tab21Els = [{Tab21, 1, 2} | [{Tab21, N, N} || N <- lists:seq(1, 10)]], 2266 Tab31Els = [{Tab31, N, N} || N <- lists:seq(1, 10)], 2267 2268 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab1Els], 2269 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab2Els], 2270 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab3Els], 2271 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab11Els], 2272 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab21Els], 2273 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab31Els], 2274 2275 Get = fun(E, A) -> [E | A] end, 2276 2277 %% Before 2278 AddB = fun(Tab, Func) -> 2279 mnesia:write({Tab, 0, 0}), 2280 mnesia:write({Tab, 1, 0}), 2281 mnesia:write({Tab, 11, 0}), 2282 mnesia:Func(Get, [], Tab) 2283 end, 2284 AddT1 = [{Tab1, 0, 0}, {Tab1, 1, 0}] ++ tl(Tab1Els) ++ [{Tab1, 11, 0}], 2285 AddT2 = lists:sort([{Tab2, 0, 0}, {Tab2, 1, 0}] ++ Tab2Els ++ [{Tab2, 11, 0}]), 2286 AddT3 = [{Tab3, 0, 0}, {Tab3, 1, 0}] ++ tl(Tab3Els) ++ [{Tab3, 11, 0}], 2287 AddT11 = [{Tab11, 0, 0}, {Tab11, 1, 0}] ++ tl(Tab11Els) ++ [{Tab11, 11, 0}], 2288 AddT21 = lists:sort([{Tab21, 0, 0}, {Tab21, 1, 0}] ++ Tab21Els ++ [{Tab21, 11, 0}]), 2289 AddT31 = [{Tab31, 0, 0}, {Tab31, 1, 0}] ++ tl(Tab31Els) ++ [{Tab31, 11, 0}], 2290 2291 ?match({atomic, AddT1}, sort_res(mnesia:transaction(AddB, [Tab1, foldl]))), 2292 ?match({atomic, AddT2}, sort_res(mnesia:transaction(AddB, [Tab2, foldl]))), 2293 ?match({atomic, AddT3}, rev_res(mnesia:transaction(AddB, [Tab3, foldl]))), 2294 ?match({atomic, AddT11}, sort_res(mnesia:transaction(AddB, [Tab11, foldr]))), 2295 ?match({atomic, AddT21}, sort_res(mnesia:transaction(AddB, [Tab21, foldr]))), 2296 ?match({atomic, AddT31}, mnesia:transaction(AddB, [Tab31, foldr])), 2297 2298 ?match({atomic, ok}, mnesia:create_table(copy, [{ram_copies, [N2]}, 2299 {record_name, Tab1}])), 2300 CopyRec = fun(NewRec, Acc) -> 2301 %% OTP-5495 2302 W = fun() -> mnesia:write(copy, NewRec, write), [NewRec| Acc] end, 2303 {atomic,Res} = sort_res(mnesia:transaction(W)), 2304 Res 2305 end, 2306 Copy = fun() -> 2307 AddT1 = mnesia:foldl(CopyRec, [], Tab1), 2308 AddT1 = sort_res(mnesia:foldl(Get, [], copy)) 2309 end, 2310 ?match({atomic, AddT1}, sort_res(mnesia:transaction(Copy))), 2311 2312 Del = fun(E, A) -> mnesia:delete_object(E), [E|A] end, 2313 DelD = fun(Tab) -> 2314 mnesia:write({Tab, 12, 12}), 2315 mnesia:delete({Tab, 0}), 2316 mnesia:foldr(Del, [], Tab), 2317 mnesia:foldl(Get, [], Tab) 2318 end, 2319 ?match({atomic, []}, sort_res(mnesia:transaction(DelD, [Tab1]))), 2320 ?match({atomic, []}, sort_res(mnesia:transaction(DelD, [Tab2]))), 2321 ?match({atomic, []}, rev_res(mnesia:transaction(DelD, [Tab3]))), 2322 2323 ListWrite = fun(Tab) -> %% OTP-3893 2324 mnesia:write({Tab, [12], 12}), 2325 mnesia:foldr(Get, [], Tab) 2326 end, 2327 ?match({atomic, [{Tab1, [12], 12}]}, sort_res(mnesia:transaction(ListWrite, [Tab1]))), 2328 ?match({atomic, [{Tab2, [12], 12}]}, sort_res(mnesia:transaction(ListWrite, [Tab2]))), 2329 ?match({atomic, [{Tab3, [12], 12}]}, rev_res(mnesia:transaction(ListWrite, [Tab3]))), 2330 2331 ?verify_mnesia(Nodes, []). 2332 2333sort_res({atomic, List}) when is_list(List) -> 2334 {atomic, lists:sort(List)}; 2335sort_res(Else) when is_list(Else) -> 2336 lists:sort(Else); 2337sort_res(Else) -> 2338 Else. 2339 2340rev_res({atomic, List}) -> 2341 {atomic, lists:reverse(List)}; 2342rev_res(Else) -> 2343 Else. 2344 2345 2346first_next(doc) -> [""]; 2347first_next(suite) -> []; 2348first_next(Config) when is_list(Config) -> 2349 Nodes = [_,N2] = ?acquire_nodes(2, Config), 2350 Tab1 = local, 2351 Tab2 = remote, 2352 Tab3 = ordered, 2353 Tab4 = bag, 2354 Tabs = [Tab1,Tab2,Tab3,Tab4], 2355 2356 ?match({atomic, ok}, mnesia:create_table(Tab1, [{ram_copies, Nodes}])), 2357 ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies, [N2]}])), 2358 ?match({atomic, ok}, mnesia:create_table(Tab3, [{ram_copies, Nodes}, 2359 {type, ordered_set}])), 2360 ?match({atomic, ok}, mnesia:create_table(Tab4, [{ram_copies, Nodes}, 2361 {type, bag}])), 2362 2363 %% Some Helpers 2364 Trans = fun(Fun) -> mnesia:transaction(Fun) end, 2365 Continue = fun(first) -> next; 2366 (last) -> prev 2367 end, 2368 LoopHelp = fun('$end_of_table',_,_,_Fun) -> []; 2369 (Key,Tab,Op,Fun) -> 2370 Next = mnesia:Op(Tab,Key), 2371 [Next |Fun(Next,Tab,Op,Fun)] 2372 end, 2373 Loop = fun(Tab,Start) -> 2374 First = mnesia:Start(Tab), 2375 Res = [First|LoopHelp(First,Tab,Continue(Start),LoopHelp)], 2376 case mnesia:table_info(Tab, type) of 2377 ordered_set when Start == first -> Res; 2378 ordered_set -> 2379 {L1,L2} = lists:split(length(Res)-1,Res), 2380 lists:reverse(L1) ++ L2; 2381 _ -> lists:sort(Res) 2382 end 2383 end, 2384 2385 %% Verify empty tables 2386 [?match({atomic, ['$end_of_table']}, 2387 Trans(fun() -> Loop(Tab,first) end)) 2388 || Tab <- Tabs], 2389 [?match({atomic, ['$end_of_table']}, 2390 Trans(fun() -> Loop(Tab,last) end)) 2391 || Tab <- Tabs], 2392 %% Verify that trans write is visible inside trans 2393 [?match({atomic, [0,10,'$end_of_table']}, 2394 Trans(fun() -> 2395 mnesia:write({Tab,0,0}), 2396 mnesia:write({Tab,10,10}), 2397 Loop(Tab,first) end)) 2398 || Tab <- Tabs], 2399 [?match({atomic, ['$end_of_table']}, 2400 Trans(fun() -> 2401 mnesia:delete({Tab,0}), 2402 mnesia:delete({Tab,10}), 2403 Loop(Tab,first) end)) 2404 || Tab <- Tabs], 2405 2406 [?match({atomic, [0,10,'$end_of_table']}, 2407 Trans(fun() -> 2408 mnesia:write({Tab,0,0}), 2409 mnesia:write({Tab,10,10}), 2410 Loop(Tab,last) end)) 2411 || Tab <- Tabs], 2412 [?match({atomic, ['$end_of_table']}, 2413 Trans(fun() -> 2414 mnesia:delete({Tab,0}), 2415 mnesia:delete({Tab,10}), 2416 Loop(Tab,last) end)) 2417 || Tab <- Tabs], 2418 2419 Tab1Els = [{Tab1, N, N} || N <- lists:seq(1, 5)], 2420 Tab2Els = [{Tab2, N, N} || N <- lists:seq(1, 5)], 2421 Tab3Els = [{Tab3, N, N} || N <- lists:seq(1, 5)], 2422 Tab4Els = [{Tab4, 1, 2} | [{Tab4, N, N} || N <- lists:seq(1, 5)]], 2423 2424 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab1Els], 2425 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab2Els], 2426 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab3Els], 2427 [mnesia:sync_dirty(fun() -> mnesia:write(E) end) || E <- Tab4Els], 2428 Keys = lists:sort(mnesia:dirty_all_keys(Tab1)), 2429 R1 = Keys++ ['$end_of_table'], 2430 [?match({atomic, R1}, Trans(fun() -> Loop(Tab,first) end)) 2431 || Tab <- Tabs], 2432 2433 [?match({atomic, R1}, Trans(fun() -> Loop(Tab,last) end)) 2434 || Tab <- Tabs], 2435 R2 = R1 -- [3], 2436 2437 [?match({atomic, R2}, Trans(fun() -> mnesia:delete({Tab,3}),Loop(Tab,first) end)) 2438 || Tab <- Tabs], 2439 [?match({atomic, R1}, Trans(fun() -> mnesia:write({Tab,3,3}),Loop(Tab,first) end)) 2440 || Tab <- Tabs], 2441 [?match({atomic, R2}, Trans(fun() -> mnesia:delete({Tab,3}),Loop(Tab,last) end)) 2442 || Tab <- Tabs], 2443 [?match({atomic, R1}, Trans(fun() -> mnesia:write({Tab,3,3}),Loop(Tab,last) end)) 2444 || Tab <- Tabs], 2445 [?match({atomic, R1}, Trans(fun() -> mnesia:write({Tab,4,19}),Loop(Tab,first) end)) 2446 || Tab <- Tabs], 2447 [?match({atomic, R1}, Trans(fun() -> mnesia:write({Tab,4,4}),Loop(Tab,last) end)) 2448 || Tab <- Tabs], 2449 2450 ?verify_mnesia(Nodes, []). 2451 2452 2453snmp_shadows(doc) -> [""]; 2454snmp_shadows(suite) -> []; 2455snmp_shadows(Config) when is_list(Config) -> 2456 Nodes = ?acquire_nodes(1, Config), 2457 Tab = snmp_shadows, 2458 io:format("With fixstring~n", []), 2459 ?match({atomic, ok}, mnesia:create_table(Tab,[{snmp,[{key,{fix_string,integer}}]}])), 2460 snmp_shadows_test(Tab), 2461 ?match({atomic, ok}, mnesia:delete_table(Tab)), 2462 io:format("Without fixstring~n", []), 2463 ?match({atomic, ok}, mnesia:create_table(Tab,[{snmp,[{key,{string,integer}}]}])), 2464 snmp_shadows_test(Tab), 2465 ?verify_mnesia(Nodes, []). 2466 2467snmp_shadows_test(Tab) -> 2468 [mnesia:dirty_write({Tab, {"string", N}, {N, init}}) || N <- lists:seq(2,8,2)], 2469 2470 CheckOrder = fun(A={_,_,{_,_,State}}, Prev) -> 2471 ?match({true, A, Prev}, {Prev < A, A, Prev}), 2472 {State,A} 2473 end, 2474 R1 = mnesia:sync_dirty(fun() -> loop_snmp(Tab, []) end), 2475 lists:mapfoldl(CheckOrder, {[],foo,foo}, R1), 2476 R2 = mnesia:transaction(fun() -> loop_snmp(Tab, []) end), 2477 ?match({atomic, R1}, R2), 2478 2479 Shadow = fun() -> 2480 ok = mnesia:write({Tab, {"string",1}, {1,update}}), 2481 ok = mnesia:write({Tab, {"string",4}, {4,update}}), 2482 ok = mnesia:write({Tab, {"string",6}, {6,update}}), 2483 ok = mnesia:delete({Tab, {"string",6}}), 2484 ok = mnesia:write({Tab, {"string",9}, {9,update}}), 2485 ok = mnesia:write({Tab, {"string",3}, {3,update}}), 2486 ok = mnesia:write({Tab, {"string",5}, {5,update}}), 2487 [Row5] = mnesia:read({Tab, {"string",5}}), 2488 ok = mnesia:delete_object(Row5), 2489 loop_snmp(Tab, []) 2490 end, 2491 R3 = mnesia:sync_dirty(Shadow), 2492 {L3,_} = lists:mapfoldl(CheckOrder, {[],foo,foo}, R3), 2493 ?match([{1,update},{2,init},{3,update},{4,update},{8,init},{9,update}], L3), 2494 ?match({atomic, ok}, mnesia:clear_table(Tab)), 2495 2496 [mnesia:dirty_write({Tab, {"string", N}, {N, init}}) || N <- lists:seq(2,8,2)], 2497 {atomic, R3} = mnesia:transaction(Shadow), 2498 {L4,_} = lists:mapfoldl(CheckOrder, {[],foo,foo}, R3), 2499 ?match([{1,update},{2,init},{3,update},{4,update},{8,init},{9,update}], L4), 2500 ok. 2501 2502loop_snmp(Tab,Prev) -> 2503 case mnesia:snmp_get_next_index(Tab,Prev) of 2504 {ok, SKey} -> 2505 {{ok,Row},_} = {mnesia:snmp_get_row(Tab, SKey),{?LINE,Prev,SKey}}, 2506 {{ok,MKey},_} = {mnesia:snmp_get_mnesia_key(Tab,SKey),{?LINE,Prev,SKey}}, 2507 ?match({[Row],Row,SKey,MKey}, {mnesia:read({Tab,MKey}),Row,SKey,MKey}), 2508 [{SKey, MKey, Row} | loop_snmp(Tab, SKey)]; 2509 endOfTable -> 2510 [] 2511 end. 2512