diff --git a/lib/mnesia/test/ext_test.erl b/lib/mnesia/test/ext_test.erl index f7f6ec5990d..7d579555119 100644 --- a/lib/mnesia/test/ext_test.erl +++ b/lib/mnesia/test/ext_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,6 +20,9 @@ -module(ext_test). +-include("mnesia_test_lib.hrl"). +-include("ext_test_server.hrl"). + %% Initializations -export([init_backend/0, add_aliases/1, remove_aliases/1, check_definition/4, semantics/2]). @@ -47,204 +50,212 @@ select/1, select/3, select/4, repair_continuation/2 ]). --ifdef(DEBUG). --define(DBG(DATA), io:format("~p:~p: ~p~n",[?MODULE, ?LINE, DATA])). --define(DBG(FORMAT, ARGS), io:format("~p:~p: " ++ FORMAT,[?MODULE, ?LINE] ++ ARGS)). --else. --define(DBG(DATA), ok). --define(DBG(FORMAT, ARGS), ok). --endif. - -%% types() -> -%% [{fs_copies, ?MODULE}, -%% {raw_fs_copies, ?MODULE}]. - -semantics(ext_ets, storage) -> ram_copies; -semantics(ext_ets, types ) -> [set, ordered_set, bag]; -semantics(ext_ets, index_types) -> [ordered]; +semantics(ext_ram_copies, storage) -> ram_copies; +semantics(ext_ram_copies, types ) -> [set, ordered_set, bag]; +semantics(ext_ram_copies, index_types) -> [ordered]; +semantics(ext_disc_only_copies, storage) -> disc_only_copies; +semantics(ext_disc_only_copies, types ) -> [set, bag]; +semantics(ext_disc_only_copies, index_types) -> [bag]; semantics(_Alias, _) -> undefined. -%% valid_op(_, _) -> -%% true. - init_backend() -> - ?DBG(init_backend), + ?DBG(), %% cheat and stuff a marker in mnesia_gvar K = backend_init_marker(), case try ets:lookup_element(mnesia_gvar, K, 2) catch _:_ -> error end of error -> - mnesia_lib:set(K, true); + mnesia_lib:set(K, true), + ok; Other -> - error({backend_already_initialized, {?MODULE, Other}}) - end, - ok. + {error, {backend_already_initialized, {?MODULE, Other}}} + end. backend_init_marker() -> {test, ?MODULE, backend_init}. +error_if_not_initialized() -> + case try ets:lookup_element(mnesia_gvar, backend_init_marker(), 2) catch _:_ -> error end of + error -> + ?DBG({backend_not_initialized, {?MODULE, error}}), + error({backend_not_initialized, {?MODULE, error}}); + _Other -> + ok + end. + add_aliases(_As) -> ?DBG(_As), - %ct:log("add_aliases(~p)", [_As]), + case init_backend() of + ok -> + ok; + _ -> + ignore + end, + error_if_not_initialized(), true = mnesia_lib:val(backend_init_marker()), ok. -remove_aliases(_) -> +remove_aliases(_As) -> + ?DBG(_As), + error_if_not_initialized(), ok. %% Table operations -check_definition(ext_ets, _Tab, _Nodes, _Props) -> - ?DBG("~p ~p ~p~n", [_Tab, _Nodes, _Props]), +check_definition(_Alias, _Tab, _Nodes, _Props) -> + ?DBG({_Alias, ext_test_server:tab_to_list(_Tab), _Nodes, _Props}), ok. -create_table(ext_ets, Tab, Props) when is_atom(Tab) -> - Tid = ets:new(Tab, [public, proplists:get_value(type, Props, set), {keypos, 2}]), - ?DBG("~p Create: ~p(~p) ~p~n", [self(), Tab, Tid, Props]), - mnesia_lib:set({?MODULE, Tab}, Tid), - ok; -create_table(_, Tag={Tab, index, {_Where, Type0}}, _Opts) -> - Type = case Type0 of - ordered -> ordered_set; - _ -> Type0 - end, - Tid = ets:new(Tab, [public, Type]), - ?DBG("~p(~p) ~p~n", [Tab, Tid, Tag]), - mnesia_lib:set({?MODULE, Tag}, Tid), - ok; -create_table(_, Tag={_Tab, retainer, ChkPName}, _Opts) -> - Tid = ets:new(ChkPName, [set, public, {keypos, 2}]), - ?DBG("~p(~p) ~p~n", [_Tab, Tid, Tag]), - mnesia_lib:set({?MODULE, Tag}, Tid), - ok. +create_table(Alias, Tab, Props) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Props}), + try error_if_not_initialized() of + ok -> + call({?FUNCTION_NAME, Alias, Tab, Props}) + catch error : {backend_not_initialized, _} = Reason -> + {aborted, Reason} + end. -delete_table(ext_ets, Tab) -> - try - ets:delete(mnesia_lib:val({?MODULE,Tab})), - mnesia_lib:unset({?MODULE,Tab}), - ok - catch _:_ -> - ?DBG({double_delete, Tab}), - ok +delete_table(Alias, Tab) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab)}), + try error_if_not_initialized() of + ok -> + call({?FUNCTION_NAME, Alias, Tab}) + catch error : {backend_not_initialized, _} = Reason -> + ok end. -load_table(ext_ets, _Tab, init_index, _Cs) -> ok; -load_table(ext_ets, _Tab, _LoadReason, _Cs) -> - ?DBG("Load ~p ~p~n", [_Tab, _LoadReason]), - ok. -%% mnesia_monitor:unsafe_create_external(Tab, ext_ets, ?MODULE, Cs). +load_table(Alias, Tab, LoadReason, Cs) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), LoadReason, Cs}), + call({?FUNCTION_NAME, Alias, Tab, LoadReason, Cs}). -sender_init(Alias, Tab, _RemoteStorage, _Pid) -> - KeysPerTransfer = 100, - {standard, - fun() -> mnesia_lib:db_init_chunk({ext,Alias,?MODULE}, Tab, KeysPerTransfer) end, - fun(Cont) -> mnesia_lib:db_chunk({ext,Alias,?MODULE}, Cont) end}. +sender_init(Alias, Tab, RemoteStorage, Pid) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), RemoteStorage, Pid}), + call({?FUNCTION_NAME, Alias, Tab, RemoteStorage, Pid, ?MODULE}). receiver_first_message(Sender, {first, Size}, _Alias, Tab) -> - ?DBG({first,Size}), + ?DBG({Sender, {first, Size}, _Alias, ext_test_server:tab_to_list(Tab)}), + error_if_not_initialized(), {Size, {Tab, Sender}}. -receive_data(Data, ext_ets, Name, Sender, {Name, Tab, Sender}=State) -> - ?DBG({Data,State}), - true = ets:insert(Tab, Data), - {more, State}; -receive_data(Data, Alias, Tab, Sender, {Name, Sender}) -> - receive_data(Data, Alias, Tab, Sender, {Name, mnesia_lib:val({?MODULE,Tab}), Sender}). +receive_data(Data, Alias, Name, Sender, State) -> + ?DBG({Data, Alias, ext_test_server:tab_to_list(Name), Sender, State}), + call({?FUNCTION_NAME, Data, Alias, Name, Sender, State}). receive_done(_Alias, _Tab, _Sender, _State) -> - ?DBG({done,_State}), + ?DBG({_Alias, ext_test_server:tab_to_list(_Tab), _Sender, _State}), + error_if_not_initialized(), ok. -close_table(Alias, Tab) -> sync_close_table(Alias, Tab). +close_table(Alias, Tab) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab)}), + error_if_not_initialized(), + sync_close_table(Alias, Tab). -sync_close_table(ext_ets, _Tab) -> - ?DBG(_Tab). +sync_close_table(Alias, Tab) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab)}), + call({?FUNCTION_NAME, Alias, Tab}). -fixtable(ext_ets, Tab, Bool) -> - ?DBG({Tab,Bool}), - ets:safe_fixtable(mnesia_lib:val({?MODULE,Tab}), Bool). +fixtable(Alias, Tab, Bool) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Bool}), + call({?FUNCTION_NAME, Alias, Tab, Bool}). -info(ext_ets, Tab, Type) -> - ?DBG({Tab,Type}), - Tid = mnesia_lib:val({?MODULE,Tab}), - try ets:info(Tid, Type) of - Val -> Val - catch _:_ -> - undefined - end. +info(Alias, Tab, Type) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Type}), + call({?FUNCTION_NAME, Alias, Tab, Type}). real_suffixes() -> - [".dat"]. + [".dat.ext"]. tmp_suffixes() -> []. %% Index -index_is_consistent(_Alias, _Ix, _Bool) -> ok. % Ignore for now -is_index_consistent(_Alias, _Ix) -> false. % Always rebuild +index_is_consistent(Alias, Ix, Bool) -> + ?DBG({Alias, ext_test_server:tab_to_list(Ix), Bool}), + call({?FUNCTION_NAME, Alias, Ix, Bool}). + +is_index_consistent(Alias, Ix) -> + ?DBG({Alias, ext_test_server:tab_to_list(Ix)}), + call({?FUNCTION_NAME, Alias, Ix}). %% Record operations validate_record(_Alias, _Tab, RecName, Arity, Type, _Obj) -> + ?DBG({_Alias, ext_test_server:tab_to_list(_Tab), RecName, Arity, Type, _Obj}), + error_if_not_initialized(), {RecName, Arity, Type}. validate_key(_Alias, _Tab, RecName, Arity, Type, _Key) -> + ?DBG({_Alias, ext_test_server:tab_to_list(_Tab), RecName, Arity, Type, _Key}), + error_if_not_initialized(), {RecName, Arity, Type}. -insert(ext_ets, Tab, Obj) -> - ?DBG({Tab,Obj}), - try - ets:insert(mnesia_lib:val({?MODULE,Tab}), Obj), - ok - catch _:Reason -> - io:format("CRASH ~p ~p~n",[Reason, mnesia_lib:val({?MODULE,Tab})]) - end. +insert(Alias, Tab, Obj) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Obj}), + call({?FUNCTION_NAME, Alias, Tab, Obj}). -lookup(ext_ets, Tab, Key) -> - ets:lookup(mnesia_lib:val({?MODULE,Tab}), Key). +lookup(Alias, Tab, Obj) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Obj}), + call({?FUNCTION_NAME, Alias, Tab, Obj}). -delete(ext_ets, Tab, Key) -> - ets:delete(mnesia_lib:val({?MODULE,Tab}), Key). +delete(Alias, Tab, Key) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Key}), + call({?FUNCTION_NAME, Alias, Tab, Key}). -match_delete(ext_ets, Tab, Pat) -> - ets:match_delete(mnesia_lib:val({?MODULE,Tab}), Pat). +match_delete(Alias, Tab, Pat) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Pat}), + call({?FUNCTION_NAME, Alias, Tab, Pat}). -first(ext_ets, Tab) -> - ets:first(mnesia_lib:val({?MODULE,Tab})). +first(Alias, Tab) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab)}), + call({?FUNCTION_NAME, Alias, Tab}). -last(Alias, Tab) -> first(Alias, Tab). +last(Alias, Tab) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab)}), + error_if_not_initialized(), + first(Alias, Tab). -next(ext_ets, Tab, Key) -> - ets:next(mnesia_lib:val({?MODULE,Tab}), Key). +next(Alias, Tab, Key) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Key}), + call({?FUNCTION_NAME, Alias, Tab, Key}). prev(Alias, Tab, Key) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Key}), + error_if_not_initialized(), next(Alias, Tab, Key). -slot(ext_ets, Tab, Pos) -> - ets:slot(mnesia_lib:val({?MODULE,Tab}), Pos). +slot(Alias, Tab, Pos) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Pos}), + call({?FUNCTION_NAME, Alias, Tab, Pos}). -update_counter(ext_ets, Tab, C, Val) -> - ets:update_counter(mnesia_lib:val({?MODULE,Tab}), C, Val). +update_counter(Alias, Tab, C, Val) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), C, Val}), + call({?FUNCTION_NAME, Alias, Tab, C, Val}). -select('$end_of_table' = End) -> End; -select({ext_ets, C}) -> ets:select(C). +select(Continuation) -> + ?DBG(Continuation), + call({?FUNCTION_NAME, Continuation}). select(Alias, Tab, Ms) -> - Res = select(Alias, Tab, Ms, 100000), - select_1(Res). - -select_1('$end_of_table') -> []; -select_1({Acc, C}) -> - case ets:select(C) of - '$end_of_table' -> Acc; - {New, Cont} -> - select_1({New ++ Acc, Cont}) - end. + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Ms}), + call({?FUNCTION_NAME, Alias, Tab, Ms}). -select(ext_ets, Tab, Ms, Limit) when is_integer(Limit); Limit =:= infinity -> - ets:select(mnesia_lib:val({?MODULE,Tab}), Ms, Limit). +select(Alias, Tab, Ms, Limit) -> + ?DBG({Alias, ext_test_server:tab_to_list(Tab), Ms, Limit}), + call({?FUNCTION_NAME, Alias, Tab, Ms, Limit}). repair_continuation(Cont, Ms) -> - ets:repair_continuation(Cont, Ms). + ?DBG({Cont, Ms}), + call({?FUNCTION_NAME, Cont, Ms}). + +call(Req) -> + error_if_not_initialized(), + case gen_server:call({global, mnesia_test_lib:get_ext_test_server_name()}, Req) of + #exception{c = Class, r = Reason, st = ST} = Ex -> + ?DBG("call ~p resulted in an exception: ~p~n", [Req, Ex]), + erlang:raise(Class, Reason, ST); + Res -> + Res + end. diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl index 4ba560e25d3..9646655aef7 100644 --- a/lib/mnesia/test/mnesia_config_test.erl +++ b/lib/mnesia/test/mnesia_config_test.erl @@ -730,8 +730,8 @@ backend_plugin_registration(doc) -> backend_plugin_registration(Config) when is_list(Config) -> Nodes = ?acquire_schema(1, [{default_properties, []} | Config]), ?match(ok, mnesia:start()), - ?match({atomic,ok}, mnesia:add_backend_type(ext_ets, ext_test)), - ?match({atomic,ok}, mnesia:add_backend_type(ext_dets, ext_test)), + ?match({atomic,ok}, mnesia:add_backend_type(ext_ram_copies, ext_test)), + ?match({atomic,ok}, mnesia:add_backend_type(ext_disc_only_copies, ext_test)), ?verify_mnesia(Nodes, []), ?cleanup(1, Config). diff --git a/lib/mnesia/test/mnesia_dirty_access_test.erl b/lib/mnesia/test/mnesia_dirty_access_test.erl index e684faf7b05..ba7e04ff1ec 100644 --- a/lib/mnesia/test/mnesia_dirty_access_test.erl +++ b/lib/mnesia/test/mnesia_dirty_access_test.erl @@ -162,7 +162,7 @@ dirty_write_disc_only(Config) when is_list(Config) -> dirty_write(Config, disc_only_copies). dirty_write_xets(Config) when is_list(Config) -> - dirty_write(Config, ext_ets). + dirty_write(Config, ext_ram_copies). dirty_write(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -196,7 +196,7 @@ dirty_read_disc_only(Config) when is_list(Config) -> dirty_read(Config, disc_only_copies). dirty_read_xets(Config) when is_list(Config) -> - dirty_read(Config, ext_ets). + dirty_read(Config, ext_ram_copies). dirty_read(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -242,7 +242,7 @@ dirty_update_counter_disc_only(Config) when is_list(Config) -> dirty_update_counter(Config, disc_only_copies). dirty_update_counter_xets(Config) when is_list(Config) -> - dirty_update_counter(Config, ext_ets). + dirty_update_counter(Config, ext_ram_copies). dirty_update_counter(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -255,7 +255,7 @@ dirty_update_counter(Config, Storage) -> ?match({'EXIT', _}, mnesia:dirty_update_counter({Tab}, 3)), ?match({'EXIT', _}, mnesia:dirty_update_counter({foo, 1}, 3)), ?match(5, mnesia:dirty_update_counter({Tab, 1}, 3)), - ?match([{Tab, 1, 5}], mnesia:dirty_read({Tab, 1})), + ?match([{Tab, 1, 5}], mnesia:dirty_read({Tab, 1})), ?match({atomic, 8}, mnesia:transaction(fun() -> mnesia:dirty_update_counter({Tab, 1}, 3) end)), @@ -287,7 +287,7 @@ dirty_delete_disc_only(Config) when is_list(Config) -> dirty_delete(Config, disc_only_copies). dirty_delete_xets(Config) when is_list(Config) -> - dirty_delete(Config, ext_ets). + dirty_delete(Config, ext_ram_copies). dirty_delete(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -327,7 +327,7 @@ dirty_delete_object_disc_only(Config) when is_list(Config) -> dirty_delete_object(Config, disc_only_copies). dirty_delete_object_xets(Config) when is_list(Config) -> - dirty_delete_object(Config, ext_ets). + dirty_delete_object(Config, ext_ram_copies). dirty_delete_object(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -373,7 +373,7 @@ dirty_match_object_disc_only(Config) when is_list(Config) -> dirty_match_object(Config, disc_only_copies). dirty_match_object_xets(Config) when is_list(Config) -> - dirty_match_object(Config, ext_ets). + dirty_match_object(Config, ext_ram_copies). dirty_match_object(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -412,7 +412,7 @@ dirty_index_match_object_disc_only(Config) when is_list(Config) -> dirty_index_match_object(Config, disc_only_copies). dirty_index_match_object_xets(Config) when is_list(Config) -> - dirty_index_match_object(Config, ext_ets). + dirty_index_match_object(Config, ext_ram_copies). dirty_index_match_object(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -452,7 +452,7 @@ dirty_index_read_disc_only(Config) when is_list(Config) -> dirty_index_read(Config, disc_only_copies). dirty_index_read_xets(Config) when is_list(Config) -> - dirty_index_read(Config, ext_ets). + dirty_index_read(Config, ext_ram_copies). dirty_index_read(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -516,7 +516,7 @@ dirty_index_update_set_disc_only(Config) when is_list(Config) -> dirty_index_update_set(Config, disc_only_copies). dirty_index_update_set_xets(Config) when is_list(Config) -> - dirty_index_update_set(Config, ext_ets). + dirty_index_update_set(Config, ext_ram_copies). dirty_index_update_set(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -611,7 +611,7 @@ dirty_index_update_bag_disc_only(Config)when is_list(Config) -> dirty_index_update_bag(Config, disc_only_copies). dirty_index_update_bag_xets(Config) when is_list(Config) -> - dirty_index_update_bag(Config, ext_ets). + dirty_index_update_bag(Config, ext_ram_copies). dirty_index_update_bag(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), @@ -732,7 +732,7 @@ dirty_iter_disc_only(Config) when is_list(Config) -> dirty_iter(Config, disc_only_copies). dirty_iter_xets(Config) when is_list(Config) -> - dirty_iter(Config, ext_ets). + dirty_iter(Config, ext_ram_copies). dirty_iter(Config, Storage) -> [Node1] = Nodes = ?acquire_nodes(1, Config), diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index db2903d7774..763d9054b7a 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -165,11 +165,11 @@ table_info(Config) when is_list(Config) -> Schema = case mnesia_test_lib:diskless(Config) of true -> [{type, Type}, {attributes, Attrs}, {index, [ValPos]}, - {ram_copies, [Node1, Node2]}, {ext_ets, [Node3]}]; + {ram_copies, [Node1, Node2]}, {ext_ram_copies, [Node3]}]; false -> [{type, Type}, {attributes, Attrs}, {index, [ValPos]}, {disc_only_copies, [Node1]}, {ram_copies, [Node2]}, - {ext_ets, [Node3]}] + {ext_ram_copies, [Node3]}] end, ?match({atomic, ok}, mnesia:create_table(Tab, Schema)), @@ -182,7 +182,7 @@ table_info(Config) when is_list(Config) -> true -> ?match(Nodes, mnesia:table_info(Tab, ram_copies)); false -> - ?match([Node3], mnesia:table_info(Tab, ext_ets)), + ?match([Node3], mnesia:table_info(Tab, ext_ram_copies)), ?match([Node2], mnesia:table_info(Tab, ram_copies)), ?match([Node1], mnesia:table_info(Tab, mnesia_test_lib:storage_type(disc_only_copies, Config))) end, @@ -258,7 +258,7 @@ db_node_lifecycle(Config) when is_list(Config) -> L1 = mnesia:table_info(T, ram_copies), L2 = mnesia:table_info(T, disc_copies), L3 = mnesia:table_info(T, disc_only_copies), - L4 = mnesia:table_info(T, ext_ets), + L4 = mnesia:table_info(T, ext_ram_copies), L1 ++ L2 ++ L3 ++ L4 end, @@ -318,7 +318,7 @@ db_node_lifecycle(Config) when is_list(Config) -> [{name, Tab3}, {ram_copies, [Node2, Node3]}], [{name, Tab4}, {disc_only_copies, [Node1]}], [{name, Tab5}, {disc_only_copies, [Node2]}], - [{name, Tab6}, {ext_ets, [Node1, Node2]}] + [{name, Tab6}, {ext_ram_copies, [Node1, Node2]}] ], [?match({atomic, ok}, mnesia:create_table(T)) || T <- Tabs ], @@ -422,7 +422,7 @@ checkpoint(NodeConfig, Config) -> CreateTab(Type, 3, [lists:last(TabNodes)])] ++ Acc end, - Types = [ram_copies, disc_copies, disc_only_copies, ext_ets], + Types = [ram_copies, disc_copies, disc_only_copies, ext_ram_copies], Tabs = lists:foldl(CreateTabs, [], Types), Recs = ?sort([{T, N, N} || T <- Tabs, N <- lists:seq(1, 10)]), lists:foreach(fun(R) -> ?match(ok, mnesia:dirty_write(R)) end, Recs), @@ -509,7 +509,7 @@ replica_location(Config) when is_list(Config) -> {ram_copies, [Node2]}, {disc_copies, [Node3]}]), Check(ext_location, [{disc_only_copies, [Node1]}, - {ext_ets, [Node2]}, {disc_copies, [Node3]}]), + {ext_ram_copies, [Node2]}, {disc_copies, [Node3]}]), ?verify_mnesia(Nodes, []). @@ -872,7 +872,7 @@ replica_management(Config) when is_list(Config) -> %% ?match({atomic, ok}, mnesia:create_table([{name, Tab}, {attributes, Attrs}, - {ram_copies, [Node1]}, {ext_ets, [Node3]}])), + {ram_copies, [Node1]}, {ext_ram_copies, [Node3]}])), [?match(ok, mnesia:dirty_write({Tab, K, K + 2})) || K <-lists:seq(1, 10)], ?match([], ?vrl(Tab, [], [Node1, Node3], [], Nodes)), %% R - - @@ -909,7 +909,7 @@ replica_management(Config) when is_list(Config) -> ?match([], ?vrl(Tab, [Node2], [], [Node1], Nodes)), ?match([0,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% D DO - - ?match({atomic, ok}, mnesia:add_table_copy(Tab, Node3, ext_ets)), + ?match({atomic, ok}, mnesia:add_table_copy(Tab, Node3, ext_ram_copies)), ?match([], ?vrl(Tab, [Node2], [Node3], [Node1], Nodes)), ?match([10,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% D DO R @@ -936,7 +936,7 @@ replica_management(Config) when is_list(Config) -> ?match([10,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% D DO D0 - ?match({atomic, ok}, mnesia:change_table_copy_type(Tab, Node3, ext_ets)), + ?match({atomic, ok}, mnesia:change_table_copy_type(Tab, Node3, ext_ram_copies)), ?match([], ?vrl(Tab, [Node2], [Node3], [Node1], Nodes)), ?match([10,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% D DO R @@ -993,7 +993,7 @@ replica_management(Config) when is_list(Config) -> ?match([], ?vrl(Tab, [Node3], [], [Node2], Nodes)), ?match([0,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% - D DO - ?match({atomic, ok}, mnesia:change_table_copy_type(Tab, Node3, ext_ets)), + ?match({atomic, ok}, mnesia:change_table_copy_type(Tab, Node3, ext_ram_copies)), ?match([], ?vrl(Tab, [], [Node3], [Node2], Nodes)), ?match([0,10,10], ?SS(rpc:multicall(Nodes, mnesia, table_info, [Tab, size]))), %% - D ER @@ -2428,7 +2428,7 @@ record_name_dirty_access_disc_only(Config) when is_list(Config) -> record_name_dirty_access(disc_only_copies, Config). record_name_dirty_access_xets(Config) when is_list(Config) -> - record_name_dirty_access(ext_ets, Config). + record_name_dirty_access(ext_ram_copies, Config). record_name_dirty_access(Storage, Config) -> diff --git a/lib/mnesia/test/mnesia_external_backend_test.erl b/lib/mnesia/test/mnesia_external_backend_test.erl index 1391be7c881..0fcb075ea8b 100644 --- a/lib/mnesia/test/mnesia_external_backend_test.erl +++ b/lib/mnesia/test/mnesia_external_backend_test.erl @@ -1,27 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + -module(mnesia_external_backend_test). -export([init_per_testcase/2, end_per_testcase/2, init_per_group/2, end_per_group/2, suite/0, all/0, groups/0]). --export([conversion_from_external_to_disc_copies_results_in_data_loss_after_node_restart/1]). +-export([ + conversion_from_external_to_disc_copies_should_not_result_in_data_loss_after_node_restart/1, + backup_and_restore_should_work_with_external_backend/1, + schema_creation_should_work_when_external_tables_exist/1 +]). -include("mnesia_test_lib.hrl"). -record(some_rec, {some_id :: atom(), some_int :: number(), some_string :: string()}). --define(acquire(N, Config), - mnesia_test_lib:prepare_test_case([{init_test_case, [mnesia]}, - delete_schema], - N, Config, ?FILE, ?LINE)). - -all() -> - [conversion_from_external_to_disc_copies_results_in_data_loss_after_node_restart]. +all() -> [ + conversion_from_external_to_disc_copies_should_not_result_in_data_loss_after_node_restart, + backup_and_restore_should_work_with_external_backend, + schema_creation_should_work_when_external_tables_exist +]. groups() -> []. init_per_testcase(Func, Conf) -> + file:delete("bup0.BUP"), + file:delete("bup1.BUP"), + file:delete("bup2.BUP"), mnesia_test_lib:init_per_testcase(Func, Conf). end_per_testcase(Func, Conf) -> @@ -35,8 +60,7 @@ end_per_group(_GroupName, Config) -> suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,1}]}]}]. -conversion_from_external_to_disc_copies_results_in_data_loss_after_node_restart(Config) when is_list(Config) -> - Node = node(), +conversion_from_external_to_disc_copies_should_not_result_in_data_loss_after_node_restart(Config) when is_list(Config) -> Data = [ #some_rec{some_id = a, some_int = 1, some_string = "something" }, #some_rec{some_id = b, some_int = 2, some_string = "anything" }, @@ -44,36 +68,108 @@ conversion_from_external_to_disc_copies_results_in_data_loss_after_node_restart( #some_rec{some_id = d, some_int = 4, some_string = "nothing" } ], - [Node] = ?acquire(1, Config), - ok = mnesia:create_schema([Node]), - ok = mnesia:start(), - {atomic, ok} = mnesia:add_backend_type(ext_ets, ext_test), - {atomic, ok} = mnesia:add_backend_type(ext_dets, ext_test), - {atomic, ok} = mnesia:create_table(table, [ + [Node] = ?acquire_nodes(1, Config), + ?match({atomic, ok}, mnesia:create_table(table, [ {type, ordered_set}, {record_name, some_rec}, {attributes, record_info(fields, some_rec)}, {disc_copies, [Node]} - ]), + ])), - ok = mnesia:activity(transaction, fun() -> + ?match(ok, mnesia:activity(transaction, fun() -> lists:foreach(fun(Elem) -> mnesia:write(table, Elem, write) end, Data) - end), + end)), - {atomic, ok} = mnesia:change_table_copy_type(table, Node, ext_ets), - Data = mnesia:activity(transaction, fun() -> + ?match({atomic, ok}, mnesia:change_table_copy_type(table, Node, ext_ram_copies)), + ?match(Data, mnesia:activity(transaction, fun() -> mnesia:match_object(table, #some_rec{_ = '_'}, read) end - ), + )), - {atomic, ok} = mnesia:change_table_copy_type(table, Node, disc_copies), - Data = mnesia:activity(transaction, fun() -> + ?match({atomic, ok}, mnesia:change_table_copy_type(table, Node, disc_copies)), + ?match(Data, mnesia:activity(transaction, fun() -> mnesia:match_object(table, #some_rec{_ = '_'}, read) end - ), + )), - stopped = mnesia:stop(), - ok = mnesia:start(), - ok = mnesia:wait_for_tables([schema, table], 10000), + ?match(stopped, mnesia:stop()), + ?match(ok, mnesia:start()), + ?match(ok, mnesia:wait_for_tables([schema, table], 10000)), - Data = mnesia:activity(transaction, fun() -> + ?match(Data, mnesia:activity(transaction, fun() -> mnesia:match_object(table, #some_rec{_ = '_'}, read) end - ). + )), + + ?verify_mnesia([Node], []). + +backup_and_restore_should_work_with_external_backend(Config) when is_list(Config) -> + Data1 = [ + #some_rec{some_id = a, some_int = 1, some_string = "1"}, + #some_rec{some_id = b, some_int = 2, some_string = "2"}, + #some_rec{some_id = c, some_int = 3, some_string = "3"} + ], + Data2 = [ + #some_rec{some_id = d, some_int = 4, some_string = "4"}, + #some_rec{some_id = e, some_int = 5, some_string = "5"}, + #some_rec{some_id = f, some_int = 6, some_string = "6"} + ], + + [Node] = ?acquire_nodes(1, Config), + ?match({atomic, ok}, mnesia:create_table(table, [ + {type, set}, + {record_name, some_rec}, + {attributes, record_info(fields, some_rec)}, + {ext_disc_only_copies, [Node]} + ])), + + ?match({atomic, ok}, mnesia:add_table_index(table, #some_rec.some_int)), + ?match([], mnesia:dirty_match_object(table, #some_rec{_ = '_'})), + ?match(ok, mnesia:backup("bup0.BUP")), + + ?match(ok, mnesia:activity(transaction, fun() -> + lists:foreach(fun(Elem) -> mnesia:write(table, Elem, write) end, Data1) + end)), + ?match(ok, mnesia:backup("bup1.BUP")), + + ?match(ok, mnesia:activity(transaction, fun() -> + lists:foreach(fun(Elem) -> mnesia:write(table, Elem, write) end, Data2) + end)), + ?match(ok, mnesia:backup("bup2.BUP")), + + ?match(ok, load_backup("bup0.BUP")), + ?match([], mnesia:dirty_match_object(table, #some_rec{_ = '_'})), + ?match([], mnesia:dirty_index_read(table, 2, #some_rec.some_int)), + + ?match(ok, load_backup("bup1.BUP")), + Expected1 = sets:from_list(Data1), + ?match(Expected1, sets:from_list(mnesia:dirty_match_object(table, #some_rec{_ = '_'}))), + ?match([#some_rec{some_id = b, some_int = 2, some_string = "2"}], mnesia:dirty_index_read(table, 2, #some_rec.some_int)), + + ?match(ok, load_backup("bup2.BUP")), + Expected2 = sets:from_list(lists:append(Data1, Data2)), + ?match(Expected2, sets:from_list(mnesia:dirty_match_object(table, #some_rec{_ = '_'}))), + ?match([#some_rec{some_id = b, some_int = 2, some_string = "2"}], mnesia:dirty_index_read(table, 2, #some_rec.some_int)), + ?match([#some_rec{some_id = e, some_int = 5, some_string = "5"}], mnesia:dirty_index_read(table, 5, #some_rec.some_int)), + + ?verify_mnesia([Node], []). + +schema_creation_should_work_when_external_tables_exist(Config) when is_list(Config) -> + [Node] = ?acquire_nodes(1, Config), + ?match({atomic, ok}, mnesia:create_table(table, [ + {type, set}, + {record_name, some_rec}, + {attributes, record_info(fields, some_rec)}, + {ext_disc_only_copies, [Node]} + ])), + + ?match(stopped, mnesia:stop()), + ?match(ok, mnesia:delete_schema([Node])), + + Ext = proplists:get_value(default_properties, Config, ?BACKEND), + ?match(ok, mnesia:create_schema([Node], Ext)). + +load_backup(BUP) -> + ?match(ok, mnesia:install_fallback(BUP)), + ?match(stopped, mnesia:stop()), + timer:sleep(3000), + ?match(ok, mnesia:start()), + ?match(ok, mnesia:wait_for_tables([schema, table], 5000)), + ok. diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl index 6bf44295b36..6a2a61f3781 100644 --- a/lib/mnesia/test/mnesia_test_lib.erl +++ b/lib/mnesia/test/mnesia_test_lib.erl @@ -103,6 +103,7 @@ start_mnesia/2, start_appls/2, start_appls/3, + start_ext_test_server/0, start_wait/2, storage_type/2, stop_mnesia/1, @@ -130,7 +131,8 @@ struct/1, init_per_testcase/2, end_per_testcase/2, - kill_tc/2 + kill_tc/2, + get_ext_test_server_name/0 ]). -include("mnesia_test_lib.hrl"). @@ -681,6 +683,10 @@ do_prepare([{start_appls, Appls} | Actions], Selected, All, Config, File, Line) do_prepare(Actions, Selected, All, Config, File, Line); do_prepare([{reload_appls, Appls} | Actions], Selected, All, Config, File, Line) -> reload_appls(Appls, Selected), + do_prepare(Actions, Selected, All, Config, File, Line); +do_prepare([start_ext_test_server | Actions], Selected, All, Config, File, Line) -> + Expected = lists:duplicate(length(Selected), ok), + {Expected, []} = rpc:multicall(Selected, ?MODULE, start_ext_test_server, []), do_prepare(Actions, Selected, All, Config, File, Line). set_kill_timer(Config) -> @@ -795,6 +801,20 @@ start_appls([Appl | Appls], Nodes, Config, Tabs) -> start_appls([], _Nodes, _Config, _Tabs) -> []. +start_ext_test_server() -> + case global:whereis_name(get_ext_test_server_name()) of + Pid when is_pid(Pid) -> + gen_server:stop({global, get_ext_test_server_name()}); + _ -> + ignore + end, + {ok, _} = gen_server:start({global, get_ext_test_server_name()}, ext_test_server, + [self()], + [{timeout, infinity} + %%, {debug, [trace]} + ]), + ok. + remote_start(mnesia, Config, Nodes) -> case diskless(Config) of true -> @@ -1031,9 +1051,10 @@ verify_replica_location(Tab, DiscOnly0, Ram0, Disc0, AliveNodes0) -> timer:sleep(100), S1 = ?match(AliveNodes, lists:sort(mnesia:system_info(running_db_nodes))), - S2 = ?match(DiscOnly, lists:sort(mnesia:table_info(Tab, disc_only_copies))), + S2 = ?match(DiscOnly, lists:sort(mnesia:table_info(Tab, disc_only_copies) ++ + mnesia:table_info(Tab, ext_disc_only_copies))), S3 = ?match(Ram, lists:sort(mnesia:table_info(Tab, ram_copies) ++ - mnesia:table_info(Tab, ext_ets))), + mnesia:table_info(Tab, ext_ram_copies))), S4 = ?match(Disc, lists:sort(mnesia:table_info(Tab, disc_copies))), S5 = ?match(Write, lists:sort(mnesia:table_info(Tab, where_to_write))), S6 = case lists:member(This, Read) of @@ -1070,3 +1091,6 @@ sort({ok, L}) when is_list(L) -> {ok, lists:sort(L)}; sort(W) -> W. + +get_ext_test_server_name() -> + list_to_atom("ext_test_server_" ++ atom_to_list(node())). diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl index cee1bb003f8..14aa4221a60 100644 --- a/lib/mnesia/test/mnesia_test_lib.hrl +++ b/lib/mnesia/test/mnesia_test_lib.hrl @@ -116,6 +116,7 @@ mnesia_test_lib:prepare_test_case([{init_test_case, [mnesia]}, delete_schema, create_schema, + start_ext_test_server, {start_appls, [mnesia]}], N, Config, ?FILE, ?LINE)). @@ -151,4 +152,4 @@ -define(verify_mnesia(Ups, Downs), mnesia_test_lib:verify_mnesia(Ups, Downs, ?FILE, ?LINE)). --define(BACKEND, [{backend_types, [{ext_ets, ext_test},{ext_dets, ext_test}]}]). +-define(BACKEND, [{backend_types, [{ext_ram_copies, ext_test}, {ext_disc_only_copies, ext_test}]}]).